diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index c7f6952ea..93854947e 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -12,7 +12,7 @@ jobs: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - name: configure run: | sudo apt update diff --git a/.github/workflows/nonanboxing2.yml b/.github/workflows/nonanboxing2.yml new file mode 100644 index 000000000..cd3df6cce --- /dev/null +++ b/.github/workflows/nonanboxing2.yml @@ -0,0 +1,42 @@ +name: NoNANBoxing-2 + +on: + push: + branches: [ "dev", "help" ] + pull_request: + branches: [ "dev", "help" ] + +jobs: + build: + + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v3 + - name: configure + run: | + sudo apt update + sudo apt install libsuitesparse-dev + sudo apt install liblapacke-dev + sudo apt install libunistring-dev + python -m pip install --upgrade pip + python -m pip install regex colored + - name: make + run: | + mkdir build + cd build + cmake -DMORPHO_DISABLENANBOXING=ON .. + sudo make install + sudo mkdir /usr/local/lib/morpho + - name: getcli + run: | + git clone https://github.com/Morpho-lang/morpho-cli.git + cd morpho-cli + mkdir build + cd build + cmake -DMORPHO_DISABLENANBOXING=ON .. + sudo make install + - name: test + run: | + cd test + python3 test.py diff --git a/.gitignore b/.gitignore index 71583e0c1..c5afddde0 100644 --- a/.gitignore +++ b/.gitignore @@ -76,3 +76,5 @@ build-xcode/* build-win/* *.valgrind /.vs +/dist +/vcpkg_installed diff --git a/CMakeLists.txt b/CMakeLists.txt index 3ac527cf5..59a9e1803 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -23,6 +23,7 @@ option(MORPHO_GCSTRESSTEST "Stress tests the garbage collector" OFF) option(MORPHO_BUILD_LINALG "Builds with linear algebra" ON) option(MORPHO_BUILD_SPARSE "Builds with sparse matrix support" ON) option(MORPHO_BUILD_GEOMETRY "Builds with geometry library" ON) +option(MORPHO_BUILD_PROFILER "Builds with profiler" ON) #------------------------------------------------------------------------------- # Process options @@ -53,6 +54,11 @@ if(MORPHO_BUILD_GEOMETRY) target_compile_definitions(morpho PUBLIC MORPHO_INCLUDE_GEOMETRY) endif() +# Build with profiler +if(MORPHO_BUILD_PROFILER) +target_compile_definitions(morpho PUBLIC _DEBUG_PROFILER) +endif() + #------------------------------------------------------------------------------- # BLAS and LAPACK #------------------------------------------------------------------------------- @@ -64,7 +70,7 @@ message(STATUS "Searching for BLAS and LAPACK") # Currently we prefer LAPACKE # TODO: Fix morpho source to select between lapack and lapacke find_library(LAPACK_LIBRARY - NAMES lapacke liblapacke lapack liblapack libopenblas + NAMES lapacke liblapacke lapack liblapack openblas libopenblas HINTS "C:\\Program Files\\Morpho\\lib\\" ) @@ -85,7 +91,7 @@ endif() # Find cblas.h header file find_path(CBLAS_INCLUDE cblas.h HINTS - "C:\\Program Files\\Morpho\\include\\lapack") + "C:\\Program Files\\Morpho\\include\\openblas") # Add cblas headers to include folders target_include_directories(morpho PUBLIC ${CBLAS_INCLUDE}) diff --git a/examples/elementtypes/qtensorCG2.morpho b/examples/elementtypes/qtensorCG2.morpho index edc6a0920..50559d654 100644 --- a/examples/elementtypes/qtensorCG2.morpho +++ b/examples/elementtypes/qtensorCG2.morpho @@ -64,7 +64,6 @@ class QTensor { self.problem.addenergy(anchor, selection=self.bnd, prefactor = self.EA) // The elastic energy is the grad-squared of the q-tensor - fn elasticity(x, q) { var g = grad(q) return g[0].inner(g[0]) + g[1].inner(g[1]) diff --git a/help/classes.md b/help/classes.md index 2f1417335..c809ee896 100644 --- a/help/classes.md +++ b/help/classes.md @@ -174,3 +174,22 @@ is equivalent to: The `clss` method is used to get the class to which an object belongs. print a.clss() + +## Superclass +[tagsuperclass]: # (superclass) + +The `superclass` method returns the superclass of an object or class: + + print a.superclass() + +## Serialize +[tagserialize]: # (serialize) + +The `serialize` method is provided as part of the base `Object` interface for objects that support serialization. + +## Linearization +[taglinearization]: # (linearization) + +The `linearization` method returns a list describing the class linearization used for method lookup: + + print a.linearization() diff --git a/help/complex.md b/help/complex.md index 2e1208abd..a66b33f47 100644 --- a/help/complex.md +++ b/help/complex.md @@ -34,6 +34,20 @@ Returns the angle `phi` associated with the polar representation of a complex nu print z.angle() +## Real +[tagreal]: # (real) + +Returns the real part of a complex number: + + print z.real() + +## Imag +[tagimag]: # (imag) + +Returns the imaginary part of a complex number: + + print z.imag() + ## Conj [tagconjugate]: # (conjugate) [tagconj]: # (conj) @@ -41,3 +55,21 @@ Returns the angle `phi` associated with the polar representation of a complex nu Returns the complex conjugate of a number: print z.conj() + +## Abs +[tagabs]: # (abs) + +Returns the magnitude of a complex number: + + print z.abs() + +## ComplexMatrix +[tagcomplexmatrix]: # (complexmatrix) + +The `ComplexMatrix` class provides complex-valued matrices. See also `Matrix`. + +Useful methods include: + + print c.real() + print c.imag() + print c.conjTranspose() diff --git a/help/controlflow.md b/help/controlflow.md index 973a1acb6..06d2b57a2 100644 --- a/help/controlflow.md +++ b/help/controlflow.md @@ -13,6 +13,8 @@ Control flow statements are used to determine whether and how many times a selec * `for` - Repeatedly execute a section of code with a counter * `while` - Repeatedly execute a section of code while a condition is true. +[showsubtopics]: # (subtopics) + ## If [tagif]: # (if) [tagelse]: # (else) diff --git a/help/dictionary.md b/help/dictionary.md index 989ffc53b..f77e008fd 100644 --- a/help/dictionary.md +++ b/help/dictionary.md @@ -28,24 +28,70 @@ Loop over keys in a dictionary: for (k in dict) print k -The `keys` method returns a Morpho List of the keys. +[showsubtopics]: # (subtopics) + +## Keys +[tagkeys]: # (keys) + +The `keys` method returns a Morpho `List` of the keys. var keys = dict.keys() // will return ["Massachusetts", "New York", "Vermont"] -The `contains` method returns a Bool value for whether the Dictionary -contains a given key. +## Contains +[tagcontains]: # (contains) + +The `contains` method returns a `Bool` value for whether the `Dictionary` contains a given key. print dict.contains("Vermont") // true print dict.contains("New Hampshire") // false -The `remove` method removes a given key from the Dictionary. +## Remove +[tagremove]: # (remove) + +The `remove` method removes a given key from the `Dictionary`. dict.remove("Vermont") print dict // { New York : Albany, Massachusetts : Boston } -The `clear` method removes all the (key, value) pairs fromt the -dictionary, resulting in an empty dictionary. +## Clear +[tagclear]: # (clear) - dict.clear() +The `clear` method removes all the `(key, value)` pairs from the dictionary, resulting in an empty dictionary. + dict.clear() print dict // { } + +## Union +[tagunion]: # (union) + +The `union` method combines two dictionaries. If the same key is present in both, the value from the second dictionary is used: + + var a = { "x" : 1, "y" : 2 } + var b = { "y" : 5, "z" : 3 } + print a.union(b) // { x : 1, y : 5, z : 3 } + +The `+` operator provides the same operation for dictionaries: + + print a+b + +## Intersection +[tagintersection]: # (intersection) + +The `intersection` method returns a dictionary containing only the keys present in both dictionaries: + + var a = { "x" : 1, "y" : 2 } + var b = { "y" : 5, "z" : 3 } + print a.intersection(b) + +## Difference +[tagdifference]: # (difference) + +The `difference` method returns a dictionary containing only the keys present in the first dictionary but not the second: + + var a = { "x" : 1, "y" : 2 } + var b = { "y" : 5 } + print a.difference(b) + +The `-` operator provides the same operation for dictionaries: + + print a-b diff --git a/help/errors.md b/help/errors.md index 55cd1b0bf..10caaf91e 100644 --- a/help/errors.md +++ b/help/errors.md @@ -27,6 +27,34 @@ You can also use the `warning` method to alert the user of a potential issue tha [showsubtopics]: # (subtopics) +## Throw +[tagthrow]: # (throw) + +Raises an `Error`, interrupting execution unless it is caught: + + myerr.throw() + +You can optionally supply a custom message: + + myerr.throw("A custom message") + +## Warning +[tagwarning]: # (warning) + +Displays an `Error` as a warning without interrupting execution: + + myerr.warning() + +To see the full list of morpho errors, look at the `errorlist` help entry. + +# Error list +[tagerrorrlist]: # (error list) +[tagerrorlist]: # (errorlist) + +A list of morpho errors: + +[showsubtopics]: # (subtopics) + ## Alloc [tagalloc]: # (alloc) @@ -195,3 +223,1714 @@ Or to be multiplied together, the number of columns of the left hand matrix must var b = Matrix([1,2]) print a*b // ok print b*a // generates a `MtrxIncmptbl` error. + +## DvZr +[tagdvzr]: # (dvzr) + +This error occurs when attempting to divide by zero: + + var a = 5 / 0 // Causes 'DvZr' + +## StckOvflw +[tagstckovflw]: # (stckovflw) + +This error occurs when the call stack exceeds its maximum depth, typically due to excessive recursion or deeply nested function calls. + +## ErrStckOvflw +[tagerrstckovflw]: # (errstckovflw) + +This error occurs when the error handler stack overflows, typically due to errors occurring within error handlers. + +## Exit +[tagexit]: # (exit) + +This error is generated when the virtual machine is halted, typically when the program exits normally. + +## MltplDsptchFld +[tagmltpldsptchfld]: # (mltpldsptchfld) + +This error occurs when multiple dispatch cannot find a method implementation that matches the provided arguments: + + class A { } + class B { } + fn method(A a) { } + fn method(B b) { } + method(1) // Causes 'MltplDsptchFld' - no matching method for integer + +## TypeChk +[tagtypechk]: # (typechk) + +This error occurs when there is a type violation, such as attempting to assign a value of one type to a variable declared with a different type: + + String x = 5 // Causes 'TypeChk' + +## NoOptArg +[tagnooptarg]: # (nooptarg) + +This error occurs when you try to pass optional arguments to a function that doesn't accept them: + + fn f(x) { return x } + f(1, y=2) // Causes 'NoOptArg' + +## UnkwnOptArg +[tagunkwnoptarg]: # (unkwnoptarg) + +This error occurs when you pass an unknown optional argument to a function: + + fn f(x, y=1) { return x + y } + f(1, z=2) // Causes 'UnkwnOptArg' + +## InvldArgsBltn +[taginvldargsbltn]: # (invldargsbltn) + +This error occurs when a built-in function is called with arguments of the wrong type: + + print(1, 2, 3) // If print expects a string, causes 'InvldArgsBltn' + +## ArrayArgs +[tagarrayargs]: # (arrayargs) + +This error occurs when creating an Array with invalid arguments. Arrays must be created with integer dimensions: + + var a = Array("invalid") // Causes 'ArrayArgs' + +## ArrayInit +[tagarrayinit]: # (arrayinit) + +This error occurs when an Array initializer is not an array or list: + + var a = Array(2, 2, "invalid") // Causes 'ArrayInit' + +## ArrayCmpt +[tagarraycmpt]: # (arraycmpt) + +This error occurs when an Array initializer has dimensions that don't match the requested dimensions: + + var a = Array(2, 2, [[1,2,3]]) // Causes 'ArrayCmpt' if dimensions don't match + +## ArrayIndx +[tagarrayindx]: # (arrayindx) + +This error occurs when indexing an Array with non-integer indices: + + var a[2,2] + a["x", "y"] // Causes 'ArrayIndx' + +## BrkOtsdLp +[tagbrkotsdlp]: # (brkotsdlp) + +This error occurs when a `break` statement is encountered outside of a loop: + + break // Causes 'BrkOtsdLp' + +## CntOtsdLp +[tagcntotsdlp]: # (cntotsdlp) + +This error occurs when a `continue` statement is encountered outside of a loop: + + continue // Causes 'CntOtsdLp' + +## ClssCrcRf +[tagclsscrcrf]: # (clsscrcrf) + +This error occurs when a class attempts to inherit from itself: + + class A < A { } // Causes 'ClssCrcRf' + +## ClssDplctImpl +[tagclssdplctimpl]: # (clssdplctimpl) + +This error occurs when a class has duplicate method implementations with the same signature: + + class A { + fn method() { } + fn method() { } // Causes 'ClssDplctImpl' + } + +## ClssLnrz +[tagclsslnrz]: # (clsslnrz) + +This error occurs when morpho cannot linearize a class hierarchy due to conflicting inheritance order. Check parent and ancestor classes for inheritance issues. + +## SlfOtsdClss +[tagslfotsdclss]: # (slfotsdclss) + +This error occurs when `self` is used outside of a class method: + + print self // Causes 'SlfOtsdClss' + +## SprOtsdClss +[tagsprotsdclss]: # (sprotsdclss) + +This error occurs when `super` is used outside of a class method: + + print super // Causes 'SprOtsdClss' + +## SprSelMthd +[tagsprselmthd]: # (sprselmthd) + +This error occurs when `super` is used incorrectly. It can only be used to select a method: + + super // Causes 'SprSelMthd' + super.method() // OK + +## SprNtFnd +[tagsprntfnd]: # (sprntfnd) + +This error occurs when a superclass cannot be found: + + class A < NonExistent { } // Causes 'SprNtFnd' + +## TooMnyArg +[tagtoomnyarg]: # (toomnyarg) + +This error occurs when too many arguments are passed to a function: + + fn f(x) { return x } + f(1, 2, 3) // Causes 'TooMnyArg' + +## TooMnyPrm +[tagtoomnyprm]: # (toomnyprm) + +This error occurs when a function is defined with too many parameters (exceeding the maximum allowed). + +## TooMnyCnst +[tagtoomnycnst]: # (toomnycnst) + +This error occurs when a program has too many constants (exceeding the maximum allowed). + +## VblDcl +[tagvbldcl]: # (vbldcl) + +This error occurs when a variable is declared multiple times in the same scope: + + var x = 1 + var x = 2 // Causes 'VblDcl' + +## FlNtFnd +[tagflntfnd]: # (flntfnd) + +This error occurs when a file cannot be found: + + import "nonexistent.morpho" // Causes 'FlNtFnd' + +## MdlNtFnd +[tagmdlntfnd]: # (mdlntfnd) + +This error occurs when a module cannot be found: + + import nonexistent // Causes 'MdlNtFnd' + +## ImprtFld +[tagimprtfld]: # (imprtfld) + +This error occurs when an import statement fails: + + import "broken.morpho" // Causes 'ImprtFld' if the file has errors + +## UnrslvdFrwdRf +[tagunrslvdfrwdrf]: # (unrslvdfrwdrf) + +This error occurs when a function is called before it is defined in the same scope: + + f() // Causes 'UnrslvdFrwdRf' + fn f() { } + +## MltVarPrmtr +[tagmltvarprmtr]: # (mltvarprmtr) + +This error occurs when a function has more than one variadic parameter: + + fn f(...args1, ...args2) { } // Causes 'MltVarPrmtr' + +## VarPrLst +[tagvarprlst]: # (varprlst) + +This error occurs when fixed parameters are placed after a variadic parameter: + + fn f(...args, x) { } // Causes 'VarPrLst' + +## OptPrmDflt +[tagoptprmdflt]: # (optprmdflt) + +This error occurs when an optional parameter's default value is not a constant: + + var x = 1 + fn f(y: x) { } // Causes 'OptPrmDflt' + +## MssngLoopBdy +[tagmssngloopbdy]: # (mssngloopbdy) + +This error occurs when a loop statement is missing its body: + + for (var i = 0; i < 10; i++) // Causes 'MssngLoopBdy' + +## NstdClss +[tagnstdclss]: # (nstdclss) + +This error occurs when attempting to define a class within another class: + + class A { + class B { } // Causes 'NstdClss' + } + +## InvldAssgn +[taginvldassgn]: # (invldassgn) + +This error occurs when attempting to assign to an invalid target: + + 5 = 10 // Causes 'InvldAssgn' + +## FnPrmSymb +[tagfnprmsymb]: # (fnprmsymb) + +This error occurs when function parameters are not symbols: + + fn f(5) { } // Causes 'FnPrmSymb' + +## PptyNmRqd +[tagpptynmrqd]: # (pptynmrqd) + +This error occurs when a property name is required but not provided. + +## InitRtn +[taginitrtn]: # (initrtn) + +This error occurs when attempting to return a value from an initializer method: + + class A { + init() { + return 5 // Causes 'InitRtn' + } + } + +## MssngIndx +[tagmssngindx]: # (mssngindx) + +This error occurs when indexing syntax is incomplete, missing required indices. + +## MssngIntlzr +[tagmssngintlzr]: # (mssngintlzr) + +This error occurs when a typed variable is declared without an initializer: + + var x: String // Causes 'MssngIntlzr' if initialization is required + +## TypeErr +[tagtypeerr]: # (typeerr) + +This error occurs when there is a type violation during assignment: + + var x: String + x = 5 // Causes 'TypeErr' + +## UnknwnType +[tagunknwntype]: # (unknwntype) + +This error occurs when an unknown type is referenced: + + var x: UnknownType // Causes 'UnknwnType' + +## UnknwnNmSpc +[tagunknwnnmspc]: # (unknwnnmspc) + +This error occurs when an unknown namespace is referenced: + + import unknown::module // Causes 'UnknwnNmSpc' + +## UnknwnTypeNmSpc +[tagunknwntypenmspc]: # (unknwntypenmspc) + +This error occurs when an unknown type is referenced in a namespace: + + var x: unknown::Type // Causes 'UnknwnTypeNmSpc' + +## SymblUndfNmSpc +[tagsymblundfnmspc]: # (symblundfnmspc) + +This error occurs when a symbol is not defined in the specified namespace: + + unknown::symbol // Causes 'SymblUndfNmSpc' + +## IncExp +[tagincexp]: # (incexp) + +This error occurs when an expression is incomplete: + + var x = 5 + // Causes 'IncExp' + +## MssngParen +[tagmssngparen]: # (mssngparen) + +This error occurs when a closing parenthesis is missing: + + fn f(x // Causes 'MssngParen' + +## ExpExpr +[tagexpexpr]: # (expexpr) + +This error occurs when an expression is expected but not found: + + var x = // Causes 'ExpExpr' + +## MssngExpTerm +[tagmssngexpterm]: # (mssngexpterm) + +This error occurs when an expression terminator (semicolon or newline) is missing after an expression. + +## VarExpct +[tagvarexpct]: # (varexpct) + +This error occurs when a variable name is expected after `var`: + + var // Causes 'VarExpct' + +## SymblExpct +[tagsymblexpct]: # (symblexpct) + +This error occurs when a symbol is expected but not found. + +## MssngBrc +[tagmssngbrc]: # (mssngbrc) + +This error occurs when a closing brace is missing: + + fn f() { // Causes 'MssngBrc' + +## MssngSqBrc +[tagmssngsqbrc]: # (mssngsqbrc) + +This error occurs when a closing square bracket is missing: + + var x = [1, 2 // Causes 'MssngSqBrc' + +## MssngComma +[tagmssngcomma]: # (mssngcomma) + +This error occurs when a comma is expected: + + var x = [1 2] // Causes 'MssngComma' + +## TrnryMssngColon +[tagtrnymssngcolon]: # (trnymssngcolon) + +This error occurs when a colon is missing in a ternary operator: + + var x = true ? 1 // Causes 'TrnryMssngColon' + +## IfMssngLftPrn +[tagifmssnglftprn]: # (ifmssnglftprn) + +This error occurs when a left parenthesis is missing after `if`: + + if x > 0 { } // Causes 'IfMssngLftPrn' + +## IfMssngRgtPrn +[tagifmssngrgtprn]: # (ifmssngrgtprn) + +This error occurs when a right parenthesis is missing after an if condition: + + if (x > 0 { } // Causes 'IfMssngRgtPrn' + +## WhlMssngLftPrn +[tagwhlmssnglftprn]: # (whlmssnglftprn) + +This error occurs when a left parenthesis is missing after `while`: + + while x > 0 { } // Causes 'WhlMssngLftPrn' + +## ForMssngLftPrn +[tagformssnglftprn]: # (formssnglftprn) + +This error occurs when a left parenthesis is missing after `for`: + + for var i = 0; i < 10; i++ { } // Causes 'ForMssngLftPrn' + +## ForMssngRgtPrn +[tagformssngrgtprn]: # (formssngrgtprn) + +This error occurs when a right parenthesis is missing after for clauses: + + for (var i = 0; i < 10; i++ { } // Causes 'ForMssngRgtPrn' + +## FnNoName +[tagfnoname]: # (fnoname) + +This error occurs when a function or method name is expected but not found: + + fn () { } // Causes 'FnNoName' + +## FnMssngLftPrn +[tagfnmssnglftprn]: # (fnmssnglftprn) + +This error occurs when a left parenthesis is missing after a function name: + + fn f { } // Causes 'FnMssngLftPrn' + +## FnMssngRgtPrn +[tagfnmssngrgtprn]: # (fnmssngrgtprn) + +This error occurs when a right parenthesis is missing after function parameters: + + fn f(x { } // Causes 'FnMssngRgtPrn' + +## FnMssngLftBrc +[tagfnmssnglftbrc]: # (fnmssnglftbrc) + +This error occurs when a left brace is missing before a function body: + + fn f() // Causes 'FnMssngLftBrc' + +## CllMssngRgtPrn +[tagcllmssngrgtprn]: # (cllmssngrgtprn) + +This error occurs when a right parenthesis is missing after function call arguments: + + f(x // Causes 'CllMssngRgtPrn' + +## ClsNmMssng +[tagclsnmssng]: # (clsnmssng) + +This error occurs when a class name is expected but not found: + + class { } // Causes 'ClsNmMssng' + +## ClsMssngLftBrc +[tagclsmssnglftbrc]: # (clsmssnglftbrc) + +This error occurs when a left brace is missing before a class body: + + class A // Causes 'ClsMssngLftBrc' + +## ClsMssngRgtBrc +[tagclsmssngrgtbrc]: # (clsmssngrgtbrc) + +This error occurs when a right brace is missing after a class body: + + class A { // Causes 'ClsMssngRgtBrc' + +## ExpctDtSpr +[tagexpctdtspr]: # (expctdtspr) + +This error occurs when a dot is expected after `super`: + + super method() // Causes 'ExpctDtSpr' + super.method() // OK + +## SprNmMssng +[tagsprnmssng]: # (sprnmssng) + +This error occurs when a superclass name is expected but not found: + + class A < { } // Causes 'SprNmMssng' + +## MxnNmMssng +[tagmxnnmssng]: # (mxnnmssng) + +This error occurs when a mixin class name is expected but not found. + +## IntrpIncmp +[tagintrpincmp]: # (intrpincmp) + +This error occurs when a string interpolation is incomplete: + + var x = "Hello ${" // Causes 'IntrpIncmp' + +## EmptyIndx +[tagemptyindx]: # (emptyindx) + +This error occurs when a variable declaration has an empty capacity: + + var x[] // Causes 'EmptyIndx' + +## ImprtMssngNm +[tagimprtmssngnm]: # (imprtmssngnm) + +This error occurs when an import statement is missing a module or file name: + + import // Causes 'ImprtMssngNm' + +## ImprtMltplAs +[tagimprtmltplas]: # (imprtmltplas) + +This error occurs when an import statement has multiple `as` clauses: + + import module as A as B // Causes 'ImprtMltplAs' + +## ImprtExpctFrAs +[tagimprtexpctfras]: # (imprtexpctfras) + +This error occurs when an import statement doesn't have the expected format: + + import module invalid // Causes 'ImprtExpctFrAs' + +## ExpctSymblAftrAs +[tagexpctsymblaftras]: # (expctsymblaftras) + +This error occurs when a symbol is expected after `as` in an import: + + import module as // Causes 'ExpctSymblAftrAs' + +## ExpctSymblAftrFr +[tagexpctsymblaftrfr]: # (expctsymblaftrfr) + +This error occurs when a symbol is expected after `for` in an import: + + import module for // Causes 'ExpctSymblAftrFr' + +## DctSprtr +[tagdctsprtr]: # (dctsprtr) + +This error occurs when a colon is missing in a dictionary key-value pair: + + var d = {"key" "value"} // Causes 'DctSprtr' + +## DctEntrySprtr +[tagdctentrysprtr]: # (dctentrysprtr) + +This error occurs when a comma is missing between dictionary entries: + + var d = {"a": 1 "b": 2} // Causes 'DctEntrySprtr' + +## DctTrmntr +[tagdcttrmntr]: # (dcttrmntr) + +This error occurs when a closing brace is missing in a dictionary: + + var d = {"a": 1 // Causes 'DctTrmntr' + +## SwtchSprtr +[tagswtchsprtr]: # (swtchsprtr) + +This error occurs when a colon is missing after a switch label: + + switch x { + case 1 // Causes 'SwtchSprtr' + } + +## ExpctWhl +[tagexpctwhl]: # (expctwhl) + +This error occurs when `while` is expected after a do-while loop body: + + do { + // body + } // Causes 'ExpctWhl' + +## ExpctCtch +[tagexpctctch]: # (expctctch) + +This error occurs when `catch` is expected after a `try` statement: + + try { + // code + } // Causes 'ExpctCtch' + +## ExpctHndlr +[tagexpcthndlr]: # (expcthndlr) + +This error occurs when an error handler block is expected after `catch`: + + try { + // code + } catch // Causes 'ExpctHndlr' + +## InvldLbl +[taginvldlbl]: # (invldlbl) + +This error occurs when an invalid label is used in a catch statement. + +## OneVarPr +[tagonevarpr]: # (onevarpr) + +This error occurs when a function has more than one variadic parameter (same as `MltVarPrmtr`). + +## ValRng +[tagvalrng]: # (valrng) + +This error occurs when a value is out of the expected range. + +## StrEsc +[tagstresc]: # (stresc) + +This error occurs when an unrecognized escape sequence is used in a string: + + var s = "\q" // Causes 'StrEsc' + +## RcrsnLmt +[tagrcrsnlmt]: # (rcrsnlmt) + +This error occurs when the parser recursion depth is exceeded, typically due to deeply nested expressions. + +## UnescpdCtrl +[tagunescpdctrl]: # (unescpdctrl) + +This error occurs when an unescaped control character is found in a string literal. + +## InvldUncd +[taginvlduncd]: # (invlduncd) + +This error occurs when an invalid unicode escape sequence is used in a string: + + var s = "\uZZZZ" // Causes 'InvldUncd' + +## UnrcgnzdTok +[tagunrcgnzdtok]: # (unrcgnzdtok) + +This error occurs when the parser encounters an unrecognized token. + +## UntrmComm +[taguntrmcomm]: # (untrmcomm) + +This error occurs when a multiline comment is not terminated: + + /* This comment // Causes 'UntrmComm' + +## UntrmStrng +[taguntrmstrng]: # (untrmstrng) + +This error occurs when a string literal is not terminated: + + var s = "This string // Causes 'UntrmStrng' + +## UnrgnzdTkn +[tagunrgnzdtkn]: # (unrgnzdtkn) + +This error occurs when the lexer encounters an unrecognized token. + +## MtrxBnds +[tagmtrxbnds]: # (mtrxbnds) + +This error occurs when attempting to access a matrix element with an index that is out of bounds: + + var m = Matrix([[1,2],[3,4]]) + print m[10, 10] // Causes 'MtrxBnds' + +## MtrxInvldIndx +[tagmtrxinvldindx]: # (mtrxinvldindx) + +This error occurs when matrix indices are not integers: + + var m = Matrix([[1,2],[3,4]]) + print m["x", "y"] // Causes 'MtrxInvldIndx' + +## MtrxInvldNumIndx +[tagmtrxinvldnumindx]: # (mtrxinvldnumindx) + +This error occurs when a matrix is indexed with the wrong number of indices: + + var m = Matrix([[1,2],[3,4]]) + print m[1] // Causes 'MtrxInvldNumIndx' (needs two indices) + +## MtrxCns +[tagmtrxcns]: # (mtrxcns) + +This error occurs when the Matrix constructor is called with invalid arguments. It should be called with dimensions or an array/list/matrix initializer: + + var m = Matrix("invalid") // Causes 'MtrxCns' + +## MtrxIdnttyCns +[tagmtrxidnttycns]: # (mtrxidnttycns) + +This error occurs when IdentityMatrix is called with invalid arguments. It expects a single dimension: + + var m = IdentityMatrix() // Causes 'MtrxIdnttyCns' + +## MtrxInvldInit +[tagmtrxinvldinit]: # (mtrxinvldinit) + +This error occurs when an invalid initializer is passed to the Matrix constructor: + + var m = Matrix([["invalid"]]) // Causes 'MtrxInvldInit' if incompatible + +## MtrxInvldArg +[tagmtrxinvldarg]: # (mtrxinvldarg) + +This error occurs when matrix arithmetic methods receive invalid arguments: + + var m = Matrix([[1,2],[3,4]]) + m + "string" // Causes 'MtrxInvldArg' + +## MtrxRShpArg +[tagmtrxrshparg]: # (mtrxrshparg) + +This error occurs when the reshape method is called with invalid arguments. It requires two integer arguments: + + var m = Matrix([[1,2],[3,4]]) + m.reshape("invalid") // Causes 'MtrxRShpArg' + +## MtrxIncmptbl +[tagmtrxincmptbl]: # (mtrxincmptbl) + +This error occurs when matrices have incompatible shapes for an operation. See the main documentation above for examples. + +## MtrxSnglr +[tagmtrxsnglr]: # (mtrxsnglr) + +This error occurs when attempting to invert a singular (non-invertible) matrix: + + var m = Matrix([[1,2],[2,4]]) // Singular matrix + m.inverse() // Causes 'MtrxSnglr' + +## MtrxNtSq +[tagmtrxntsq]: # (mtrxntsq) + +This error occurs when a matrix operation requires a square matrix but a non-square matrix is provided: + + var m = Matrix([[1,2,3],[4,5,6]]) // 2x3 matrix + m.inverse() // Causes 'MtrxNtSq' + +## MtrxOpFld +[tagmtrxopfld]: # (mtrxopfld) + +This error occurs when a matrix operation fails for an unspecified reason. + +## MtrxNrmArgs +[tagmtrxnrmargs]: # (mtrxnrmargs) + +This error occurs when the norm method is called with invalid arguments. It expects an optional numerical argument: + + var m = Matrix([[1,2],[3,4]]) + m.norm("invalid") // Causes 'MtrxNrmArgs' + +## MtrxStClArgs +[tagmtrxstclargs]: # (mtrxstclargs) + +This error occurs when `setColumn` is called with invalid arguments. It expects an integer column index and a column matrix: + + var m = Matrix([[1,2],[3,4]]) + m.setColumn("invalid", Matrix([1,2])) // Causes 'MtrxStClArgs' + +The older method name `setcolumn` is retained for compatibility but is deprecated. + +## LnAlgMtrxIncmptbl +[taglnalgmtrxincmptbl]: # (lnalgmtrxincmptbl) + +This error occurs when matrices have incompatible shapes in linear algebra operations. + +## LnAlgMtrxIndxBnds +[taglnalgmtrxindxbnds]: # (lnalgmtrxindxbnds) + +This error occurs when a matrix index is out of bounds in linear algebra operations. + +## LnAlgMtrxSnglr +[taglnalgmtrxsnglr]: # (lnalgmtrxsnglr) + +This error occurs when a matrix is singular in linear algebra operations. + +## LnAlgMtrxNtSq +[taglnalgmtrxntsq]: # (lnalgmtrxntsq) + +This error occurs when a matrix is not square in linear algebra operations. + +## LnAlgLapackArgs +[taglnalglapackargs]: # (lnalglapackargs) + +This error occurs when a LAPACK function is called with invalid arguments. + +## LnAlgMtrxOpFld +[taglnalgmtrxopfld]: # (lnalgmtrxopfld) + +This error occurs when a matrix operation fails in the linear algebra library. + +## LnAlgMtrxNtSpprtd +[taglnalgmtrxntspprtd]: # (lnalgmtrxntspprtd) + +This error occurs when an operation is not supported for a particular matrix type. + +## LnAlgMtrxInvldArg +[taglnalgmtrxinvldarg]: # (lnalgmtrxinvldarg) + +This error occurs when invalid arguments are passed to a matrix method in the linear algebra library. + +## LnAlgMtrxNnNmrclArg +[taglnalgmtrxnnnmrclarg]: # (lnalgmtrxnnnmrclarg) + +This error occurs when a matrix method requires numerical arguments but receives non-numerical ones. + +## LnAlgMtrxNrmArgs +[taglnalgmtrxnrmargs]: # (lnalgmtrxnrmargs) + +This error occurs when the norm method is called with an unsupported argument. It requires 1 or inf: + + var m = Matrix([[1,2],[3,4]]) + m.norm(2) // Causes 'LnAlgMtrxNrmArgs' if 2 is not supported + +## LnAlgInvldArg +[taglnalginvldarg]: # (lnalginvldarg) + +This error occurs when matrix arithmetic methods receive invalid arguments: + + var m = Matrix([[1,2],[3,4]]) + m + "string" // Causes 'LnAlgInvldArg' + +## SprsCns +[tagsprscns]: # (sprscns) + +This error occurs when the Sparse constructor is called with invalid arguments. It should be called with dimensions or an array initializer: + + var s = Sparse("invalid") // Causes 'SprsCns' + +## SprsInvldInit +[tagsprsinvldinit]: # (sprsinvldinit) + +This error occurs when an invalid initializer is passed to the Sparse constructor. + +## SprsSt +[tagsprsst]: # (sprsst) + +This error occurs when attempting to set a sparse matrix element fails. + +## SprsCnvFld +[tagsprscnvfld]: # (sprscnvfld) + +This error occurs when sparse format conversion fails. + +## SprsOpFld +[tagsprsopfld]: # (sprsopfld) + +This error occurs when a sparse matrix operation fails. + +## CmplxCns +[tagcmplxcns]: # (cmplxcns) + +This error occurs when the Complex constructor is called with invalid arguments. It should be called with two floats: + + var c = Complex(1) // Causes 'CmplxCns' + +## CmplxInvldArg +[tagcmplxinvldarg]: # (cmplxinvldarg) + +This error occurs when complex arithmetic methods receive invalid arguments: + + var c = Complex(1, 2) + c + "string" // Causes 'CmplxInvldArg' + +## CmpxArg +[tagcmpxarg]: # (cmpxarg) + +This error occurs when a complex operation receives unexpected arguments. + +## LstArgs +[taglstargs]: # (lstargs) + +This error occurs when a List is created with invalid arguments. Lists must be called with integer dimensions: + + var l = List("invalid") // Causes 'LstArgs' + +## LstNumArgs +[taglstnumargs]: # (lstnumargs) + +This error occurs when a List is indexed with more than one argument: + + var l = [1, 2, 3] + l[1, 2] // Causes 'LstNumArgs' + +## LstAddArgs +[taglstaddargs]: # (lstaddargs) + +This error occurs when the add method receives invalid arguments. It requires a list: + + var l = [1, 2, 3] + l.add("invalid") // Causes 'LstAddArgs' + +## LstSrtFn +[taglstsrtfn]: # (lstsrtfn) + +This error occurs when a list sort function doesn't return an integer: + + var l = [3, 1, 2] + l.sort(fn(a, b) { return "invalid" }) // Causes 'LstSrtFn' + +## EntryNtFnd +[tagentryntfnd]: # (entryntfnd) + +This error occurs when an entry is not found in a list: + + var l = [1, 2, 3] + l.remove(10) // Causes 'EntryNtFnd' + +## TplArgs +[tagtplargs]: # (tplargs) + +This error occurs when a Tuple is created with invalid arguments. Tuples must be called with integer dimensions: + + var t = Tuple("invalid") // Causes 'TplArgs' + +## TpmNumArgs +[tagtpmnumargs]: # (tpmnumargs) + +This error occurs when a Tuple is indexed with more than one argument: + + var t = (1, 2, 3) + t[1, 2] // Causes 'TpmNumArgs' + +## DctKyNtFnd +[tagdctkyntfnd]: # (dctkyntfnd) + +This error occurs when a key is not found in a dictionary: + + var d = {"a": 1} + print d["b"] // Causes 'DctKyNtFnd' + +## DctStArg +[tagdctstarg]: # (dctstarg) + +This error occurs when dictionary set methods (union, intersection, difference) receive invalid arguments. They expect a dictionary: + + var d1 = {"a": 1} + d1.union("invalid") // Causes 'DctStArg' + +## FlOpnFld +[tagflopnfld]: # (flopnfld) + +This error occurs when a file cannot be opened: + + var f = File("nonexistent.txt", "read") // Causes 'FlOpnFld' if file doesn't exist + +## FlNmMssng +[tagflnmssng]: # (flnmssng) + +This error occurs when a filename is missing in a File operation: + + var f = File() // Causes 'FlNmMssng' + +## FlNmArgs +[tagflnmargs]: # (flnmargs) + +This error occurs when the first argument to File is not a filename: + + var f = File(123, "read") // Causes 'FlNmArgs' + +## FlMode +[tagflmode]: # (flmode) + +This error occurs when the second argument to File is not a valid mode. It should be 'read', 'write', or 'append': + + var f = File("test.txt", "invalid") // Causes 'FlMode' + +## FlWrtArgs +[tagflwrtargs]: # (flwrtargs) + +This error occurs when File.write receives non-string arguments: + + var f = File("test.txt", "write") + f.write(123) // Causes 'FlWrtArgs' + +## FlWrtFld +[tagflwrtfld]: # (flwrtfld) + +This error occurs when writing to a file fails. + +## FldrExpctPth +[tagfldrexpctpth]: # (fldrexpctpth) + +This error occurs when folder methods receive invalid arguments. They expect a path: + + Folder.exists(123) // Causes 'FldrExpctPth' + +## NtFldr +[tagntfldr]: # (ntfldr) + +This error occurs when a path is not a folder: + + Folder.exists("file.txt") // May cause 'NtFldr' if it's a file, not a folder + +## FldrCrtFld +[tagfldrcrtfld]: # (fldrcrtfld) + +This error occurs when folder creation fails: + + Folder.create("/invalid/path") // Causes 'FldrCrtFld' + +## RngArgs +[tagrngargs]: # (rngargs) + +This error occurs when Range receives invalid arguments. It expects numerical arguments: a start, an end, and an optional stepsize: + + Range("invalid") // Causes 'RngArgs' + +## RngStpSz +[tagrngstpsz]: # (rngstpsz) + +This error occurs when a Range stepsize is too small: + + Range(0, 10, 0.0000001) // May cause 'RngStpSz' if too small + +## ExpctNmArgs +[tagexpctnmargs]: # (expctnmargs) + +This error occurs when a function expects numerical arguments but receives non-numerical ones: + + sqrt("string") // Causes 'ExpctNmArgs' + +## ExpctArgNm +[tagexpctargnm]: # (expctargnm) + +This error occurs when a function expects a single numerical argument but receives something else: + + abs() // Causes 'ExpctArgNm' + +## TypArgNm +[tagtypargnm]: # (typargnm) + +This error occurs when a function expects one argument but receives a different number: + + type() // May cause 'TypArgNm' if no arguments provided + +## MnMxArgs +[tagmnmxargs]: # (mnmxargs) + +This error occurs when min or max functions receive invalid arguments. They expect at least one numerical argument, list, or matrix: + + min() // Causes 'MnMxArgs' + +## ApplyArgs +[tagapplyargs]: # (applyargs) + +This error occurs when the apply function receives fewer than two arguments: + + apply() // Causes 'ApplyArgs' + +## ApplyNtCllble +[tagapplyntcllble]: # (applyntcllble) + +This error occurs when apply receives a non-callable object as its first argument: + + apply("not a function", [1, 2, 3]) // Causes 'ApplyNtCllble' + +## FrmtArg +[tagfrmtarg]: # (frmtarg) + +This error occurs when the format method receives invalid arguments. It requires a format string: + + "test".format(123) // Causes 'FrmtArg' if format string expected + +## InvldFrmt +[taginvldfrmt]: # (invldfrmt) + +This error occurs when an invalid format string is provided: + + "test".format("%Z") // May cause 'InvldFrmt' if %Z is invalid + +## ErrorArgs +[tagerrorargs]: # (errorargs) + +This error occurs when the Error constructor is called with invalid arguments. It must be called with a tag and a default message: + + Error("Tag") // Causes 'ErrorArgs' + +## Err +[tagerr]: # (err) + +This is a generic error tag used for general error conditions. + +## EnmrtArgs +[tagenmrtargs]: # (enmrtargs) + +This error occurs when the enumerate method receives invalid arguments. It expects a single integer argument: + + var obj = Object() + obj.enumerate("invalid") // Causes 'EnmrtArgs' + +## IndxArgs +[tagindxargs]: # (indxargs) + +This error occurs when the index method receives invalid arguments. It expects a String property name: + + var obj = Object() + obj.index(123) // Causes 'IndxArgs' + +## SetIndxArgs +[tagsetindxargs]: # (setindxargs) + +This error occurs when the setindex method receives invalid arguments. It expects an index and a value: + + var obj = Object() + obj.setindex(1) // Causes 'SetIndxArgs' (missing value) + +## RspndsToArg +[tagrspndstoarg]: # (rspndstoarg) + +This error occurs when the respondsto method receives invalid arguments. It expects a single string argument or no argument: + + var obj = Object() + obj.respondsto(123) // Causes 'RspndsToArg' + +## HasArg +[taghasarg]: # (hasarg) + +This error occurs when the has method receives invalid arguments. It expects a single string argument or no argument: + + var obj = Object() + obj.has(123) // Causes 'HasArg' + +## IsMmbrArg +[tagismmbrarg]: # (ismmbrarg) + +This error occurs when the ismember method receives invalid arguments. It expects a single argument: + + var obj = Object() + obj.ismember() // Causes 'IsMmbrArg' + +## ObjCantClone +[tagobjcantclone]: # (objcantclone) + +This error occurs when attempting to clone an object that cannot be cloned: + + var obj = Object() + obj.clone() // May cause 'ObjCantClone' if cloning not supported + +## ObjImmutable +[tagobjimmutable]: # (objimmutable) + +This error occurs when attempting to modify an immutable object: + + var obj = Object() + // If obj is immutable: + obj.property = "value" // Causes 'ObjImmutable' + +## ObjNoPrp +[tagobjnoprp]: # (objnoprp) + +This error occurs when an object does not provide properties: + + var obj = Object() + obj.property // May cause 'ObjNoPrp' if object doesn't support properties + +## InvocationArgs +[taginvocationargs]: # (invocationargs) + +This error occurs when Invocation is called with invalid arguments. It must be called with an object and a method name: + + Invocation() // Causes 'InvocationArgs' + +## SystmSlpArgs +[tagsystmslpargs]: # (systmslpargs) + +This error occurs when the sleep method receives invalid arguments. It expects a time in seconds: + + sleep("invalid") // Causes 'SystmSlpArgs' + +## SystmStWrkDr +[tagsystmstwrkdr]: # (systmstwrkdr) + +This error occurs when setting the working directory fails: + + System.setworkingdirectory("/invalid/path") // Causes 'SystmStWrkDr' + +## SystmStWrkDrArgs +[tagsystmstwrkdrargs]: # (systmstwrkdrargs) + +This error occurs when setworkingdirectory receives invalid arguments. It expects a path name: + + System.setworkingdirectory(123) // Causes 'SystmStWrkDrArgs' + +## JSONPrsArgs +[tagjsonprsargs]: # (jsonprsargs) + +This error occurs when JSON.parse receives invalid arguments. It requires a string: + + JSON.parse(123) // Causes 'JSONPrsArgs' + +## JSONObjctKey +[tagjsonobjctkey]: # (jsonobjctkey) + +This error occurs when a JSON object key is not a string: + + JSON.parse('{123: "value"}') // Causes 'JSONObjctKey' + +## JSONNmbrFrmt +[tagjsonnmbrfrmt]: # (jsonnmbrfrmt) + +This error occurs when a number in JSON is improperly formatted: + + JSON.parse('{"num": 1.2.3}') // Causes 'JSONNmbrFrmt' + +## JSONExtrnsTkn +[tagjsonextrnstkn]: # (jsonextrnstkn) + +This error occurs when there is an extraneous token after a JSON element: + + JSON.parse('{"a": 1} extra') // Causes 'JSONExtrnsTkn' + +## JSONBlnkElmnt +[tagjsonblnkelmnt]: # (jsonblnkelmnt) + +This error occurs when a blank element is found in JSON: + + JSON.parse('[,]') // Causes 'JSONBlnkElmnt' + +## MshFlNtFnd +[tagmshflntfnd]: # (mshflntfnd) + +This error occurs when a mesh file cannot be found: + + var m = Mesh("nonexistent.mesh") // Causes 'MshFlNtFnd' + +## MshArgs +[tagmshargs]: # (mshargs) + +This error occurs when Mesh receives invalid arguments. It expects either a single file name or no arguments: + + var m = Mesh(123) // Causes 'MshArgs' + +## MshVrtMtrxDim +[tagmshvrtmtrxdim]: # (mshvrtmtrxdim) + +This error occurs when vertex matrix dimensions are inconsistent with the mesh. + +## MshLdVrtDim +[tagmshldvrtdim]: # (mshldvrtdim) + +This error occurs when a vertex has inconsistent dimensions when loading a mesh file. + +## MshLdVrtCrd +[tagmshldvrtcrd]: # (mshldvrtcrd) + +This error occurs when a vertex has non-numerical coordinates when loading a mesh file. + +## MshLdPrsErr +[tagmshldprserr]: # (mshldprserr) + +This error occurs when there is a parse error in a mesh file. + +## MshLdVrtNm +[tagmshldvrtnm]: # (mshldvrtnm) + +This error occurs when an element has an incorrect number of vertices when loading a mesh file. + +## MshLdVrtId +[tagmshldvrtid]: # (mshldvrtid) + +This error occurs when a vertex id is not an integer when loading a mesh file. + +## MshLdVrtNtFnd +[tagmshldvrtntfnd]: # (mshldvrtntfnd) + +This error occurs when a vertex is not found when loading a mesh file. + +## MshStVrtPsnArgs +[tagmshstvrtpsnargs]: # (mshstvrtpsnargs) + +This error occurs when setvertexposition receives invalid arguments. It expects a vertex id and a position matrix: + + var m = Mesh() + m.setvertexposition("invalid") // Causes 'MshStVrtPsnArgs' + +## MshVrtPsnArgs +[tagmshvrtpsnargs]: # (mshvrtpsnargs) + +This error occurs when vertexposition receives invalid arguments. It expects a vertex id: + + var m = Mesh() + m.vertexposition() // Causes 'MshVrtPsnArgs' + +## MshInvldId +[tagmshinvldid]: # (mshinvldid) + +This error occurs when an invalid element id is used: + + var m = Mesh() + m.element(-1) // Causes 'MshInvldId' + +## MshCnnMtxArgs +[tagmshcnnmtxargs]: # (mshcnnmtxargs) + +This error occurs when connectivitymatrix receives invalid arguments. It expects integer arguments: + + var m = Mesh() + m.connectivitymatrix("invalid") // Causes 'MshCnnMtxArgs' + +## MshAddGrdArgs +[tagmshaddgrdargs]: # (mshaddgrdargs) + +This error occurs when addgrade receives invalid arguments. It expects either an integer grade and optionally a sparse connectivity matrix: + + var m = Mesh() + m.addgrade("invalid") // Causes 'MshAddGrdArgs' + +## MshAddGrdOutOfBnds +[tagmshaddgrdoutofbnds]: # (mshaddgrdoutofbnds) + +This error occurs when attempting to add elements of a grade that exceeds the mesh's maximum grade: + + var m = Mesh() + m.addgrade(10) // Causes 'MshAddGrdOutOfBnds' if max grade is lower + +## MshAddSymArgs +[tagmshaddsymargs]: # (mshaddsymargs) + +This error occurs when addsymmetry receives invalid arguments. It expects an object that provides a transform method and optionally a selection: + + var m = Mesh() + m.addsymmetry("invalid") // Causes 'MshAddSymArgs' + +## MshAddSymMsngTrnsfrm +[tagmshaddsymmsngtrnsfrm]: # (mshaddsymmsngtrnsfrm) + +This error occurs when addsymmetry receives an object that doesn't provide a transform method: + + var m = Mesh() + var obj = Object() + m.addsymmetry(obj) // Causes 'MshAddSymMsngTrnsfrm' + +## SlNoMsh +[tagslnomsh]: # (slnomsh) + +This error occurs when a Selection operation requires a Mesh object but doesn't receive one: + + var s = Selection("invalid") // Causes 'SlNoMsh' + +## SlIsSlArg +[tagslisslarg]: # (slisslarg) + +This error occurs when Selection.isselected receives invalid arguments. It requires a grade and element id: + + var s = Selection(mesh) + s.isselected(1) // Causes 'SlIsSlArg' (missing element id) + +## SlGrdArg +[tagslgrdarg]: # (slgrdarg) + +This error occurs when a Selection method requires a grade as an argument but doesn't receive one: + + var s = Selection(mesh) + s.method() // Causes 'SlGrdArg' if grade required + +## SlStArg +[tagslstarg]: # (slstarg) + +This error occurs when Selection set methods receive invalid arguments. They require a selection: + + var s = Selection(mesh) + s.union("invalid") // Causes 'SlStArg' + +## SlBnd +[tagslbnd]: # (slbnd) + +This error occurs when a mesh has no boundary elements: + + var m = Mesh() + m.boundary() // Causes 'SlBnd' if no boundary exists + +## FldMshArg +[tagfldmsharg]: # (fldmsharg) + +This error occurs when Field receives invalid arguments. It expects a mesh as its first argument: + + var f = Field("invalid") // Causes 'FldMshArg' + +## FldArgs +[tagfldargs]: # (fldargs) + +This error occurs when Field receives invalid optional arguments. It allows 'grade' as an optional argument. + +## FldBnds +[tagfldbnds]: # (fldbnds) + +This error occurs when a Field index is out of bounds: + + var f = Field(mesh) + f[100, 100, 100] // Causes 'FldBnds' if out of bounds + +## FldInvldIndx +[tagfldinvldindx]: # (fldinvldindx) + +This error occurs when Field indices are not numerical: + + var f = Field(mesh) + f["x", "y", "z"] // Causes 'FldInvldIndx' + +## FldInvldArg +[tagfldinvldarg]: # (fldinvldarg) + +This error occurs when Field arithmetic methods receive invalid arguments. They expect a field or number: + + var f = Field(mesh) + f + "string" // Causes 'FldInvldArg' + +## FldIncmptbl +[tagfldincmptbl]: # (fldincmptbl) + +This error occurs when fields have incompatible shapes: + + var f1 = Field(mesh1) + var f2 = Field(mesh2) + f1 + f2 // Causes 'FldIncmptbl' if shapes incompatible + +## FldIncmptblVal +[tagfldincmptblval]: # (fldincmptblval) + +This error occurs when an assignment value has an incompatible shape with field elements: + + var f = Field(mesh) + f[0, 0, 0] = Matrix([[1,2,3,4]]) // Causes 'FldIncmptblVal' if shape doesn't match + +## FldOp +[tagfldop]: # (fldop) + +This error occurs when Field.op receives invalid arguments. It requires a callable object as the first argument and fields of compatible shape as other arguments: + + var f = Field(mesh) + f.op("not callable", f) // Causes 'FldOp' + +## FldOpFn +[tagfldopfn]: # (fldopfn) + +This error occurs when Field.op cannot construct a Field from the return value of the function: + + var f = Field(mesh) + f.op(fn(x) { return "invalid" }, f) // Causes 'FldOpFn' + +## FnSpcArgs +[tagfnspcargs]: # (fnspcargs) + +This error occurs when a FunctionSpace is created with invalid arguments. It must be initialized with a label and a grade: + + FunctionSpace("invalid") // Causes 'FnSpcArgs' + +## FnSpcNtFnd +[tagfnspcntfnd]: # (fnspcntfnd) + +This error occurs when a function space cannot be found: + + FunctionSpace.find("nonexistent", 1) // Causes 'FnSpcNtFnd' + +## FnctlIntMsh +[tagfnctlintmsh]: # (fnctlintmsh) + +This error occurs when a functional's integrand method requires a mesh as an argument but doesn't receive one: + + var func = Length() + func.integrand() // Causes 'FnctlIntMsh' + +## FnctlELNtFnd +[tagfnctleltfnd]: # (fnctleltfnd) + +This error occurs when a mesh doesn't provide elements of the required grade: + + var func = Length() + func.integrand(mesh) // Causes 'FnctlELNtFnd' if mesh lacks required grade + +## FnctlArgs +[tagfnctlargs]: # (fnctlargs) + +This error occurs when invalid arguments are passed to a functional method. + +## VolEnclZero +[tagvolenclzero]: # (volenclzero) + +This error occurs when VolumeEnclosed detects an element of zero size. Check that a mesh point is not coincident with the origin: + + var func = VolumeEnclosed() + func.total(mesh) // Causes 'VolEnclZero' if element has zero size + +## LnElstctyRef +[taglnelstctyref]: # (lnelstctyref) + +This error occurs when LinearElasticity requires a mesh as an argument but doesn't receive one: + + var func = LinearElasticity() + func.total() // Causes 'LnElstctyRef' + +## LnElstctyPrp +[taglnelstctyprp]: # (lnelstctyprp) + +This error occurs when LinearElasticity is missing required properties. It requires 'reference' to be a mesh, 'grade' to be an integer, and 'poissonratio' to be a number: + + var func = LinearElasticity() + func.reference = "invalid" // Causes 'LnElstctyPrp' + +## HydrglArgs +[taghydrglargs]: # (hydrglargs) + +This error occurs when Hydrogel receives invalid arguments. It requires a reference mesh and allows 'grade', 'a', 'b', 'c', 'd', 'phi0', and 'phiref' as optional arguments. + +## HydrglPrp +[taghydrglprp]: # (hydrglprp) + +This error occurs when Hydrogel is missing required properties. It requires the first argument to be a mesh, 'grade' to be an integer, 'a', 'b', 'c', 'd', 'phiref' to be numbers, and 'phi0' to be a number or Field. + +## HydrglFldGrd +[taghydrglfldgrd]: # (hydrglfldgrd) + +This error occurs when Hydrogel is given phi0 as a Field that lacks scalar elements in the required grade. + +## HydrglZrRfVl +[taghydrglzrrfvl]: # (hydrglzrrfvl) + +This error occurs when a Hydrogel reference element has a tiny volume. This is a warning. + +## HydrglBnds +[taghydrglbnds]: # (hydrglbnds) + +This error occurs when phi is outside bounds in a Hydrogel calculation. This is a warning. + +## EquiElArgs +[tagequielargs]: # (equielargs) + +This error occurs when EquiElement receives invalid arguments. It allows 'grade' and 'weight' as optional arguments. + +## GradSqArgs +[taggradsqargs]: # (gradsqargs) + +This error occurs when GradSq receives invalid arguments. It requires a field as the argument: + + var func = GradSq() + func.total("invalid") // Causes 'GradSqArgs' + +## NmtcArgs +[tagnmtcargs]: # (nmtcargs) + +This error occurs when Nematic receives invalid arguments. It requires a field as the argument: + + var func = Nematic() + func.total("invalid") // Causes 'NmtcArgs' + +## NmtcElArgs +[tagnmtcelargs]: # (nmtcelargs) + +This error occurs when NematicElectric receives invalid arguments. It requires the director and electric field or potential as arguments (in that order). + +## SclrPtFnCllbl +[tagsclrptfncllbl]: # (sclrptfncllbl) + +This error occurs when a ScalarPotential function is not callable: + + var func = ScalarPotential() + func.function = "invalid" // Causes 'SclrPtFnCllbl' + +## IntgrlArgs +[tagintgrlargs]: # (intgrlargs) + +This error occurs when an Integral functional receives invalid arguments. It requires a callable argument followed by zero or more Fields: + + var func = LineIntegral() + func.total("invalid") // Causes 'IntgrlArgs' + +## IntgrlMthdDct +[tagintgrlmthddct]: # (intgrlmthddct) + +This error occurs when an Integral's method argument is not a Dictionary containing configuration settings: + + var func = LineIntegral() + func.method = "invalid" // Causes 'IntgrlMthdDct' + +## IntgrlFld +[tagintgrlfld]: # (intgrlfld) + +This error occurs when an Integral cannot identify a field: + + var func = LineIntegral() + func.total(fn(x) { return x }, "invalid") // Causes 'IntgrlFld' + +## IntgrlGrdEvl +[tagintgrlgrdevl]: # (intgrlgrdevl) + +This error occurs when gradient evaluation fails in an Integral: + + var func = LineIntegral() + func.gradient(mesh) // Causes 'IntgrlGrdEvl' if evaluation fails + +## IntgrlAmbgsFld +[tagintgrlambgsfld]: # (intgrlambgsfld) + +This error occurs when a field reference is ambiguous in an Integral. Call with a Field object: + + var func = LineIntegral() + func.total(fn(x) { return x }) // Causes 'IntgrlAmbgsFld' if ambiguous + +## IntgrlNFlds +[tagintgrlnflds]: # (intgrlnflds) + +This error occurs when an incorrect number of Fields is provided for an integrand function: + + var func = LineIntegral() + func.total(fn(x, y) { return x + y }, field1) // Causes 'IntgrlNFlds' if wrong number + +## IntgrlSpclFn +[tagintgrlspclfn]: # (intgrlspclfn) + +This error occurs when a special function is called outside of an Integral: + + tangent() // Causes 'IntgrlSpclFn' (must be called within integrand) + +## IntgrtrSbdvns +[tagintgrtrsbdvns]: # (intgrtrsbdvns) + +This error occurs when too many subdivisions are needed in evaluating an integral, possibly indicating a singularity: + + // Occurs during numerical integration when subdivision limit is exceeded + +## IntgrtrRlNtFnd +[tagintgrtrrlntfnd]: # (intgrtrrlntfnd) + +This error occurs when an integrator quadrature rule cannot be found: + + var method = {"rule": "nonexistent"} + // Causes 'IntgrtrRlNtFnd' when rule doesn't exist + +## IntgrtrRlUnavlb +[tagintgrtrrlunavlb]: # (intgrtrrlunavlb) + +This error occurs when no quadrature rule is available that matches the provided integrator method dictionary: + + var method = {"rule": "invalid", "degree": 100} + // Causes 'IntgrtrRlUnavlb' if no matching rule + +## IntgrtrMthdTyp +[tagintgrtrmthdtyp]: # (intgrtrmthdtyp) + +This error occurs when an integrator method dictionary option has the wrong type: + + var method = {"rule": 123} // Causes 'IntgrtrMthdTyp' if rule must be string + +## DbgSymbl +[tagdbgsymbl]: # (dbgsymbl) + +This error occurs in the debugger when a symbol cannot be found in the current context: + + // Occurs when debugging and accessing a symbol that doesn't exist + +## DbgSymblPrpty +[tagdbgsymblprpty]: # (dbgsymblprpty) + +This error occurs in the debugger when a symbol lacks a requested property: + + // Occurs when debugging and accessing a property that doesn't exist + +## DbgInvldRg +[tagdbginvldrg]: # (dbginvldrg) + +This error occurs in the debugger when an invalid register is accessed: + + // Occurs when debugging and accessing an invalid register + +## DbgInvldGlbl +[tagdbginvldglbl]: # (dbginvldglbl) + +This error occurs in the debugger when an invalid global is accessed: + + // Occurs when debugging and accessing an invalid global + +## DbgInvldInstr +[tagdbginvldinstr]: # (dbginvldinstr) + +This error occurs in the debugger when an invalid instruction is encountered: + + // Occurs when debugging and encountering an invalid instruction + +## DbgRgObj +[tagdbgrgobj]: # (dbgrgobj) + +This error occurs in the debugger when a register doesn't contain an object: + + // Occurs when debugging and expecting an object in a register + +## DbgStPrp +[tagdbgstprp]: # (dbgstprp) + +This error occurs in the debugger when attempting to set a property on an object that doesn't support it: + + // Occurs when debugging and trying to set a property diff --git a/help/fespace.md b/help/fespace.md new file mode 100644 index 000000000..bd3a7cd9c --- /dev/null +++ b/help/fespace.md @@ -0,0 +1,80 @@ +[comment]: # (Finite element space help) +[version]: # (0.5) + +# FiniteElementSpace +[tagfiniteelementspace]: # (FiniteElementSpace) +[tagfespace]: # (fespace) + +The `FiniteElementSpace` class describes how a `Field` is discretized on a particular grade of a mesh. + +You can create a finite element space directly from its label and grade: + + var fs = FiniteElementSpace("CG2", grade=2) + +You can also obtain a finite element space from an existing field: + + var fs = f.finiteElementSpace() + +[showsubtopics]: # (subtopics) + +## Count +[tagcount]: # (count) + +Returns the number of nodes in the finite element space: + + print fs.count() + +## Grade +[taggrade]: # (grade) + +Returns the mesh grade on which the finite element space is defined: + + print fs.grade() + +## Layout +[taglayout]: # (layout) + +Returns a sparse matrix describing how the degrees of freedom of a given field are laid out for this finite element space: + + var layout = fs.layout(f) + print layout + +This is useful when you need to understand how local node values are mapped into the underlying storage of a `Field`. + +For example: + + var fs = f.finiteElementSpace() + var layout = fs.layout(f) + print layout + +## NodeElementIndex +[tagnodeelementindex]: # (nodeelementindex) + +Returns a tuple describing where a given node stores its degree of freedom in a field. The tuple has the form `(grade, element id, index)`: + + print fs.nodeElementIndex(0) + +This can be used together with `Field` indexing to locate the value associated with a given node. + +For example: + + var loc = fs.nodeElementIndex(0) + print loc + +## NodeCoords +[tagnodecoords]: # (nodecoords) + +Returns barycentric coordinates for the nodes of the finite element space. With no argument, this returns a matrix containing the coordinates of every node: + + print fs.nodeCoords() + +With an integer argument, it returns the barycentric coordinates for a single node: + + print fs.nodeCoords(0) + +For a grade `g` space, each node coordinate is represented by `g+1` barycentric coordinates. + +For example, to inspect all node coordinates: + + var coords = fs.nodeCoords() + print coords diff --git a/help/field.md b/help/field.md index 0e9d4d65c..a108d6581 100644 --- a/help/field.md +++ b/help/field.md @@ -62,6 +62,74 @@ The `shape` method returns a list indicating the number of items stored on each would indicate one item stored on each vertex and two items stored on each facet. +## FiniteElementSpace +[tagfiniteelementspace]: # (finiteelementspace) + +Returns the `FiniteElementSpace` used to discretize the field: + + var fs = f.finiteElementSpace() + print fs.grade() + +See also `FiniteElementSpace`. + +## Prototype +[tagprototype]: # (prototype) + +Returns the prototype value used by the field: + + print f.prototype() + +## EvalElement +[tagevalelement]: # (evalelement) + +Evaluates a field inside a specific element using barycentric coordinates: + + print f.evalElement(el, [0.2, 0.3, 0.5]) + +You can supply the barycentric coordinates either as a `List` or as a column `Matrix`. + +The number of barycentric coordinates should match the number of vertices of the reference element, i.e. `grade+1`. + +For example: + + var val = f.evalElement(el, [0.2, 0.3, 0.5]) + print val + +## ElementDofs +[tagelementdofs]: # (elementdofs) + +Returns a list describing which field entries contribute to a given element. Each entry is a tuple of the form `(grade, element id, index)`: + + print f.elementDofs(el) + +A typical return value might look like + + [ (0, 3, 0), (0, 7, 0), (0, 8, 0) ] + +for a linear field on a triangular element. + +For example: + + var dofs = f.elementDofs(el) + print dofs + +## Linearize +[taglinearize]: # (linearize) + +Returns a matrix containing the data stored by the field: + + var mat = f.linearize() + print mat + +## __linearize +[tagxlinearize]: # (__linearize) + +Returns the underlying storage matrix directly. + +This method is intended for low-level use: + + var mat = f.__linearize() + ## Op [tagop]: # (op) diff --git a/help/file.md b/help/file.md index fc8c8f86f..5a9f54aca 100644 --- a/help/file.md +++ b/help/file.md @@ -29,8 +29,7 @@ After you're done with the file, close it with f.close() -[show]: # (subtopics) - +[showsubtopics]: # (subtopics) ## lines [taglines]: # (lines) @@ -61,6 +60,15 @@ Read in the contents of a file and print each line: Reads a single character from a file; returns the result as a string. +## readall +[tagreadall]: # (readall) + +Reads the remaining contents of a file and returns them as a single string: + + var f = File("input.txt") + print f.readall() + f.close() + ## write [tagwrite]: # (write) @@ -68,7 +76,7 @@ Writes to a file. Write the contents of a list to a file: - var f = File("output.txt", "w") + var f = File("output.txt", "write") for (k, i in list) f.write("${i}: ${k}") f.close() @@ -82,15 +90,62 @@ Closes an open file. Returns true if at the end of the file; false otherwise +## relativepath +[tagrelativepath]: # (relativepath) + +Returns the file path relative to the current working directory: + + print f.relativepath() + +## filename +[tagfilename]: # (filename) + +Returns the filename that was used to open the file: + + print f.filename() + # Folder [tagfolder]: # (Folder) -The `Folder` class enables you to find whether a filepath refers to a folder, and find the contents of that folder. +The `Folder` class allows you to work with folders. You can find whether a filepath refers to a folder, obtain the contents of that folder and create folders. -Find whether a path refers to a folder: +[showsubtopics]: # (subtopics) +## isFolder +[tagisfolder]: # (isfolder) +[tagisFolder]: # (isfolder) +Find out whether a path specification refers to a folder: - print Folder.isfolder("path/folder") + print Folder.isFolder("path/folder") +## contents +[tagcontents]: # (contents) + Get a list of a folder's contents: print Folder.contents("path/folder") + +## normalizePath +[tagnormalizepath]: # (normalizepath) +This method of `Folder` normalizes a file path, replacing folder separators with the correct ones for the current platform, i.e. \ on windows or / on macOS and linux. + +Get a normalizad path: + + print Folder.normalizePath("/foo/foo") + +## create +[tagcreate]: # (create) +[tagcreaterecursive]: # (createrecursive) +The `create` and `createRecursive` methods allow creation of folders. To create a new Folder: + + Folder.create("foo") + +Recursively create a nested set of folders: + + Folder.createRecursive("foo/foo") + +## createRecursive +[tagcreateRecursive]: # (createrecursive) + +Creates a nested set of folders recursively: + + Folder.createRecursive("foo/foo") diff --git a/help/functionals.md b/help/functionals.md index e4048b15a..389037863 100644 --- a/help/functionals.md +++ b/help/functionals.md @@ -21,6 +21,65 @@ Each of these may be called with a mesh, a field and a selection. [showsubtopics]: # (subtopics) +## Total +[tagtotal]: # (total) + +The `total` method returns the value of a functional: + + print fnl.total(mesh) + +You can also supply optional fields and a selection as appropriate for the functional. + +## Integrand +[tagintegrand]: # (integrand) + +The `integrand` method returns the contribution from each element: + + print fnl.integrand(mesh) + +## IntegrandForElement +[tagintegrandforelement]: # (integrandforelement) + +Some functionals also provide an `integrandForElement` method that evaluates the integrand for a single element: + + print fnl.integrandForElement(mesh, element) + +## Gradient +[taggradient]: # (gradient) + +The `gradient` method returns the derivative of a functional with respect to vertex motion: + + print fnl.gradient(mesh) + +## Fieldgradient +[tagfieldgradient]: # (fieldgradient) + +Functionals that depend on a field may provide a `fieldgradient` method that returns the derivative with respect to field values: + + print fnl.fieldgradient(mesh, f) + +## Hessian +[taghessian]: # (hessian) + +Some functionals provide a `hessian` method: + + print fnl.hessian(mesh) + +For example, a typical workflow for a field-dependent functional is + + var value = fnl.total(mesh) + var gradx = fnl.gradient(mesh) + var gradf = fnl.fieldgradient(mesh, f) + +where `value` is the functional value, `gradx` is the derivative with respect to vertex positions and `gradf` is the derivative with respect to field values. + +For example, for a field-dependent functional: + + var fnl = GradSq(phi) + print fnl.total(mesh) + print fnl.gradient(mesh) + print fnl.fieldgradient(mesh, phi) + ## Length [taglength]: # (length) @@ -282,7 +341,7 @@ See the `Functionals` entry for general information about functionals. The `AreaIntegral` functional computes the area integral of a function. You supply an integrand function that takes a position matrix as an argument. -To compute integral(x*y) over an area element: +To compute `integral(x*y)` over an area element: var la=AreaIntegral(fn (x) x[0]*x[1]) @@ -346,3 +405,22 @@ Manually set the coefficients and grade to operate on: lfh.grade = 2, lfh.phi0 = 0.5, lfh.phiref = 0.1 See the `Functionals` entry for general information about functionals. + +## Jump +[tagjump]: # (jump) + +The `Jump` functional computes an interface contribution over interior codimension-1 mesh elements. It evaluates your integrand on interfaces shared by exactly two parent elements and ignores boundary interfaces. + +Initialize a jump functional with an integrand and any fields it depends on: + + var j = Jump(fn (x, phi) jumpdn(phi)^2, phi) + +The integrand receives the interface position `x` followed by the interpolated field values in the order supplied to `Jump`. + +Within a `Jump` integrand, the special function `jumpdn(field)` returns the jump in the normal derivative of a supplied field across the current interface. + +`Jump` also accepts the same optional integration settings as the integral functionals. In particular, the `method` dictionary may specify a `strategy` of `"centroid"` or `"quadrature"`: + + var j = Jump(fn (x, phi) jumpdn(phi)^2, phi, method: {"strategy": "quadrature"}) + +See the `Functionals` entry for general information about functionals. diff --git a/help/functions.md b/help/functions.md index f062b6aea..209ce1d6d 100644 --- a/help/functions.md +++ b/help/functions.md @@ -36,8 +36,7 @@ The correct implementation is then selected at runtime: f("Hello World!") // expect: A string! -[show]: # (subtopics) - +[showsubtopics]: # (subtopics) ## Variadic [tagvariadic]: # (variadic) diff --git a/help/graphics.md b/help/graphics.md index f5627d8e3..3bf983b83 100644 --- a/help/graphics.md +++ b/help/graphics.md @@ -28,7 +28,7 @@ To combine graphics objects, use the add operator: // ... Show(g1+g2) -[show]: # (subtopics) +[showsubtopics]: # (subtopics) ## Show [tagshow]: # (Show) diff --git a/help/index.rst b/help/index.rst index 918fa3849..c1d26a43a 100644 --- a/help/index.rst +++ b/help/index.rst @@ -34,6 +34,7 @@ Morpho :maxdepth: 1 field + fespace functionals mesh selection diff --git a/help/json.md b/help/json.md index 3185e3312..9074fc0bd 100644 --- a/help/json.md +++ b/help/json.md @@ -15,8 +15,30 @@ To parse a string that contains JSON, use the `parse` method: Elements in the JSON string are converted to equivalent morpho values. -To convert basic data types to JSON, use the `tostring` method: +To convert basic data types to JSON, use the `JSON.tostring` class method: var b = JSON.tostring([1,2,3]) The exporter supports `nil`, boolean values `true` and `false`, numbers, `String`s as well as `List` and `Dictionary` objects that may contain any of the supported types. + +[showsubtopics]: # (subtopics) + +## Parse +[tagparse]: # (parse) + +Parses a JSON string and converts it into the corresponding Morpho value: + + var a = JSON.parse("[1,2,3,4]") + print a + +If the JSON contains arrays or objects, these are converted into Morpho `List` and `Dictionary` values. + +## tostring +[tagtostring]: # (tostring) + +Converts supported Morpho values into a JSON string: + + var s = JSON.tostring([1,2,3]) + print s + +This method supports `nil`, booleans, numbers, `String`, `List` and `Dictionary` values containing supported data. diff --git a/help/list.md b/help/list.md index d996d27e6..065254a92 100644 --- a/help/list.md +++ b/help/list.md @@ -80,12 +80,14 @@ This function should return a negative value if `ab` ## Order [tagorder]: # (order) -Returns a list of indices that would, if used in order, would sort a list. For example +Returns a tuple of indices that would, if used in order, sort a list, without modifying the original list. For example var list = [2,3,1] - print list.order() // expect: [2,0,1] + print list.order() // expect: (2,0,1) -would produce `[2,0,1]` +would produce `(2,0,1)` + +In contrast to `sort`, `order` does not modify the list. ## Remove [tagremove]: # (remove) @@ -103,13 +105,13 @@ Tests if a value is a member of a list: var list = [1,2,3] print list.ismember(1) // expect: true -## Add -[tagadd]: # (add) +## Join +[tagjoin]: # (join) Join two lists together: var l1 = [1,2,3], l2 = [4, 5, 6] - print l1+l2 // expect: [1,2,3,4,5,6] + print l1.join(l2) // expect: [1,2,3,4,5,6] ## Tuples [tagtuples]: # (tuples) diff --git a/help/matrix.md b/help/matrix.md index 6e28fa063..81e665eb0 100644 --- a/help/matrix.md +++ b/help/matrix.md @@ -26,6 +26,8 @@ Finally, you can create a Matrix by assembling other matrices like this, var a = Matrix([[0,1],[1,0]]) var b = Matrix([[a,0],[0,a]]) // produces a 4x4 matrix +The `ComplexMatrix` class provides the corresponding support for complex-valued matrices and supports the same core indexing, slicing, decomposition and arithmetic operations, together with methods such as `real`, `imag`, `conjugate` and `conjTranspose`. + Once a matrix is created, you can use all the regular arithmetic operators with matrix operands, e.g. a+b @@ -39,6 +41,11 @@ or create a submatrix using slices: print a[0..1,0..1] +If a matrix is a row or column vector, it can also be sliced with a single argument: + + var v = Matrix([1,2,3]) + print v[0..1] + The division operator is used to solve a linear system, e.g. var a = Matrix([[1,2],[3,4]]) @@ -46,7 +53,7 @@ The division operator is used to solve a linear system, e.g. print b/a -yields the solution to the system a*x = b. +yields the solution to the system `a*x = b`. [showsubtopics]: # (subtopics) @@ -65,15 +72,29 @@ The two matrices must have the same dimensions. Returns the dimensions of a matrix: var A = Matrix([1,2,3]) // Create a column matrix - print A.dimensions() // Expect: [ 3, 1 ] + print A.dimensions() // Expect: (3, 1) + +## Column +[tagcolumn]: # (column) + +Returns a specified column of a matrix as a column matrix: + + var v = A.column(0) + +## Setcolumn +[tagsetcolumn]: # (setcolumn) + +Replaces a specified column of a matrix: + + A.setcolumn(0, Matrix([1,2,3])) ## Eigenvalues [tageigenvalues]: # (Eigenvalues) -Returns a list of eigenvalues of a Matrix: +Returns a tuple of eigenvalues of a Matrix: var A = Matrix([[0,1],[1,0]]) - print A.eigenvalues() // Expect: [1,-1] + print A.eigenvalues() // Expect: (1,-1) ## Eigensystem [tageigensystem]: # (Eigensystem) @@ -83,14 +104,46 @@ Returns the eigenvalues and eigenvectors of a Matrix: var A = Matrix([[0,1],[1,0]]) print A.eigensystem() -Eigensystem returns a two element list: The first element is a List of eigenvalues. The second element is a Matrix containing the corresponding eigenvectors as its columns: +Eigensystem returns a two element tuple: The first element is a tuple of eigenvalues. The second element is a Matrix containing the corresponding eigenvectors as its columns: print A.eigensystem()[0] - // [ 1, -1 ] + // (1, -1) print A.eigensystem()[1] // [ 0.707107 -0.707107 ] // [ 0.707107 0.707107 ] +## SVD +[tagsvd]: # (SVD) + +The 'svd' method returns the singular value decomposition of a matrix as a three element tuple: + + var svd = A.svd() + +The return value contains the left singular vectors, singular values, and right singular vectors in that order. + +If `A` is a matrix, its singular value decomposition factors it as + + A = U S V^T + +where `U` and `V` are orthogonal matrices and `S` contains the singular values of `A`. + +The SVD is useful for understanding the numerical rank of a matrix, solving least-squares problems, and analyzing the dominant modes or directions present in the data represented by a matrix. + +## QR +[tagqr]: # (QR) + +The 'qr' method returns the QR decomposition of a matrix as a two element tuple: + + var qr = A.qr() + +If `A` is a matrix, its QR decomposition factors it as + + A = Q R + +where `Q` is orthogonal and `R` is upper triangular. + +The QR decomposition is useful for solving linear least-squares problems and for constructing numerically stable orthogonal bases from the columns of a matrix. + ## Inner [taginner]: # (Inner) @@ -116,23 +169,22 @@ Returns the inverse of a matrix if it is invertible. Raises a var m = Matrix([[1,2],[3,4]]) var mi = m.inverse() -yields the inverse of the matrix `m`, such that mi*m is the identity +yields the inverse of the matrix `m`, such that `mi*m` is the identity matrix. ## Norm [tagnorm]: # (Norm) -Returns a matrix norm. By default the L2 norm is returned: +Returns a matrix norm. By default the Frobenius norm is returned: var a = Matrix([1,2,3,4]) print a.norm() // Expect: sqrt(30) = 5.47723... -You can select a different norm by supplying an argument: +You can select a different supported norm by supplying an argument: import constants - print a.norm(1) // Expect: 10 (L1 norm is sum of absolute values) - print a.norm(3) // Expect: 4.64159 (An unusual choice of norm) - print a.norm(Inf) // Expect: 4 (Inf-norm corresponds to maximum absolute value) + print a.norm(1) // Expect: 10 (L1 norm) + print a.norm(Inf) // Expect: 4 (Infinity norm) ## Reshape [tagreshape]: # (Reshape) @@ -181,3 +233,50 @@ Elements that roll beyond the last position are re-introduced at the first. Constructs an identity matrix of a specified size: var a = IdentityMatrix(size) + +## ComplexMatrix +[tagcomplexmatrix]: # (ComplexMatrix) + +The `ComplexMatrix` class provides support for complex-valued matrices. It can be initialized in the same ways as `Matrix`, for example + + var a = ComplexMatrix(2,2) + var b = ComplexMatrix((1+1im, 2+2im, 3+3im)) + var c = ComplexMatrix([[1+1im, 2], [3, 4-1im]]) + +`ComplexMatrix` supports the same core indexing, slicing, arithmetic and decomposition methods as `Matrix`, including `inverse`, `norm`, `sum`, `trace`, `transpose`, `eigenvalues`, `eigensystem`, `svd`, `qr`, `reshape` and `roll`. + +As with `Matrix`, single-argument slicing is supported for row and column vectors. + +For `ComplexMatrix`, `eigenvalues()` and the first component of `eigensystem()` may contain complex values. + +In addition, `ComplexMatrix` provides methods for accessing and manipulating the complex structure: + + var r = c.real() + var i = c.imag() + var z = c.conjugate() + var h = c.conjTranspose() + +`conjugate()` returns the elementwise complex conjugate of the matrix, while `conjTranspose()` returns the conjugate transpose (also called the Hermitian transpose). + +Mixed arithmetic between `Matrix` and `ComplexMatrix` is supported, with the result promoted to complex where needed. + +## Real +[tagreal]: # (real) + +Returns a `Matrix` containing the real part of a `ComplexMatrix`: + + print c.real() + +## Imag +[tagimag]: # (imag) + +Returns a `Matrix` containing the imaginary part of a `ComplexMatrix`: + + print c.imag() + +## ConjTranspose +[tagconjtranspose]: # (conjtranspose) + +Returns the conjugate transpose of a `ComplexMatrix`: + + print c.conjTranspose() diff --git a/help/mesh.md b/help/mesh.md index 49a2c7cb0..693c2d824 100644 --- a/help/mesh.md +++ b/help/mesh.md @@ -16,7 +16,7 @@ Each type of element is referred to as belonging to a different `grade`. Point-l The `plot` package includes functions to visualize meshes. -[showsubtopics]: # (showsubtopics) +[showsubtopics]: # (subtopics) ## Save [tagsave]: # (Save) @@ -25,6 +25,21 @@ Saves a mesh as a .mesh file. m.save("new.mesh") +## Vertexmatrix +[tagvertexmatrix]: # (vertexmatrix) + +Returns the matrix of vertex positions used by the mesh. Each column corresponds to a vertex: + + var verts = m.vertexmatrix() + print verts + +## Setvertexmatrix +[tagsetvertexmatrix]: # (setvertexmatrix) + +Replaces the matrix of vertex positions used by the mesh. The new matrix must have the same dimensions as the existing vertex matrix: + + m.setvertexmatrix(newverts) + ## Vertexposition [tagvertexposition]: # (vertexposition) @@ -39,6 +54,28 @@ Sets the position of a vertex given an id and a position vector: print m.setvertexposition(1, Matrix([0,0,0])) +## Resetconnectivity +[tagresetconnectivity]: # (resetconnectivity) + +Clears any cached connectivity matrices associated with the mesh: + + m.resetconnectivity() + +## Connectivitymatrix +[tagconnectivitymatrix]: # (connectivitymatrix) + +Returns the connectivity matrix that maps elements of one grade to another. For example, to retrieve the vertex-to-edge connectivity: + + var c = m.connectivitymatrix(0, 1) + print c + +Here `0` refers to vertices and `1` to edges. Similarly, `m.connectivitymatrix(0, 2)` retrieves the vertex-to-facet connectivity. + +For example, to inspect the connectivity between vertices and facets: + + var cf = m.connectivitymatrix(0, 2) + print cf + ## Addgrade [tagaddgrade]: # (addgrade) @@ -46,11 +83,40 @@ Adds a new grade to a mesh. This is commonly used when, for example, a mesh file m.addgrade(1) +You can also provide an explicit sparse connectivity matrix for the new grade: + + m.addgrade(1, connectivity) + +## Removegrade +[tagremovegrade]: # (removegrade) + +Removes a grade and its associated connectivity from a mesh: + + m.removegrade(1) + ## Addsymmetry [tagaddsymmetry]: # (addsymmetry) Adds a symmetry to a mesh. Experimental in version 0.5. +## Barycentric +[tagbarycentric]: # (barycentric) + +Computes barycentric coordinates for a point inside a mesh element. You must supply the grade, the element id and the position matrix: + + var lambda = m.barycentric(2, el, Matrix([x, y, z])) + print lambda + +For a grade `g` element, the returned matrix contains `g+1` barycentric coordinates. + +For example, for a triangular facet (`grade 2`), the returned matrix contains three barycentric coordinates whose sum is `1`. + +For example: + + var x = Matrix([0.25, 0.25, 0.0]) + var lambda = m.barycentric(2, el, x) + print lambda + ## Maxgrade [tagmaxgrade]: # (maxgrade) @@ -64,3 +130,10 @@ Returns the highest grade element present: Counts the number of elements. If no argument is provided, returns the number of vertices. Otherwise, returns the number of elements present of a given grade: print m.count(2) // Returns the number of area-like elements. + +## Clone +[tagclone]: # (clone) + +Creates a copy of a mesh: + + var copy = m.clone() diff --git a/help/meshslice.md b/help/meshslice.md index f69814167..6a9befb57 100644 --- a/help/meshslice.md +++ b/help/meshslice.md @@ -27,6 +27,8 @@ The new field returned by `slicefield` lives on the sliced mesh. You can slice a You can perform multiple slices with the same `MeshSlicer` simply by calling `slice` again with a different plane. +[showsubtopics]: # (subtopics) + ## SlcEmpty [tagslcempty]: # (slcempty) diff --git a/help/selection.md b/help/selection.md index 6e76f7835..5b5f760bb 100644 --- a/help/selection.md +++ b/help/selection.md @@ -30,6 +30,32 @@ To add additional grades, use the addgrade method. For example, to add areas: [showsubtopics]: # subtopics +## union +[tagunion]: # (union) +Combines two selections into a new `Selection` containing elements present in either selection: + + var s = s1.union(s2) + +The `+` operator provides the same operation for selections: + + var s = s1+s2 + +## intersection +[tagintersection]: # (intersection) +Returns a new `Selection` containing only elements present in both selections: + + var s = s1.intersection(s2) + +## difference +[tagdifference]: # (difference) +Returns a new `Selection` containing elements present in the first selection but not the second: + + var s = s1.difference(s2) + +The `-` operator provides the same operation for selections: + + var s = s1-s2 + ## addgrade [tagaddgrade]: # (addgrade) Adds elements of the specified grade to a Selection. For example, to add edges to an existing selection, use @@ -64,4 +90,4 @@ Checks if an element id is selected, returning `true` or `false` accordingly. To check if edge number 5 is selected: - var f = s.isselected(1, 5)) + var f = s.isselected(1, 5) diff --git a/help/sparse.md b/help/sparse.md index b320f81f6..87409f8f8 100644 --- a/help/sparse.md +++ b/help/sparse.md @@ -25,3 +25,53 @@ Once a sparse matrix is created, you can use all the regular arithmetic operator a+b a*b + +[showsubtopics]: # (subtopics) + +## Rowindices +[tagrowindices]: # (rowindices) + +Returns the row indices of the nonzero entries in a specified column: + + print a.rowindices(0) + +For the matrix + + var a = Sparse([[0,0,2], [1,1,-2], [2,0,5]]) + +`a.rowindices(0)` would return `[0,2]`. + +For example: + + var rows = a.rowindices(0) + print rows + +## Setrowindices +[tagsetrowindices]: # (setrowindices) + +Replaces the row indices of the nonzero entries in a specified column: + + a.setrowindices(0, [0,2,4]) + +This acts on the sparse column representation, so the argument refers to a column index. + +## Colindices +[tagcolindices]: # (colindices) + +Returns the column indices that contain nonzero entries: + + print a.colindices() + +For the example above, `a.colindices()` would return `[0,1]`. + +For example: + + var cols = a.colindices() + print cols + +## Indices +[tagindices]: # (indices) + +Returns the row and column indices used by the sparse matrix representation: + + print a.indices() diff --git a/help/syntax.md b/help/syntax.md index b7c185939..bf0b3bffc 100644 --- a/help/syntax.md +++ b/help/syntax.md @@ -12,6 +12,8 @@ Morpho programs are stored as plain text with the .morpho file extension. A prog morpho5 program.morpho +[showsubtopics]: # (subtopics) + ## Comments [tagcomment]: # (comment) [tagcomments]: # (comments) @@ -38,7 +40,7 @@ enabling the programmer to quickly comment out a section of code. [tagsymbols]: # (symbols) [tagnames]: # (names) -Symbols are used to refer to named entities, including variables, classes, functions etc. Symbols must begin with a letter or underscore _ as the first character and may include letters or numbers as the remainder. Symbols are case sensitive. +Symbols are used to refer to named entities, including variables, classes, functions etc. Symbols must begin with a letter or underscore `_` as the first character and may include letters or numbers as the remainder. Symbols are case sensitive. asymbol _alsoasymbol diff --git a/help/system.md b/help/system.md index bb9e8ba4b..c7882b788 100644 --- a/help/system.md +++ b/help/system.md @@ -59,9 +59,9 @@ Returns a `List` of arguments passed to the current morpho on the command line. Run a morpho program with arguments: - morpho5 program.morpho hello world + morpho6 program.morpho hello world -Note that, in line with UNIX conventions, command line arguments before the program file name are passed to the `morpho5` runtime; those after are passed to the morpho program via `System.arguments`. +Note that, in line with UNIX conventions, command line arguments before the program file name are passed to the `morpho6` runtime; those after are passed to the morpho program via `System.arguments`. ## Exit [tagexit]: # (exit) @@ -69,3 +69,24 @@ Note that, in line with UNIX conventions, command line arguments before the prog Stop execution of a program: System.exit() + +## Setworkingfolder +[tagsetworkingfolder]: # (setworkingfolder) + +Sets the current working folder used by the runtime: + + System.setworkingfolder("/tmp") + +## Workingfolder +[tagworkingfolder]: # (workingfolder) + +Returns the current working folder: + + print System.workingfolder() + +## Homefolder +[taghomefolder]: # (homefolder) + +Returns the current user's home folder: + + print System.homefolder() diff --git a/help/tuple.md b/help/tuple.md index 8f19995d8..a5822d098 100644 --- a/help/tuple.md +++ b/help/tuple.md @@ -4,7 +4,7 @@ # Tuple [tagtuple]: # (Tuple) -Tuples are collection objects that contain a sequence of values each associated with an integer index. Unlike Lists, they can't be changed after creation. +Tuples are collection objects that contain a sequence of values each associated with an integer index. Unlike Lists, they can't be changed after creation, so they form Morpho's immutable sequence type. Create a tuple like this: @@ -35,7 +35,56 @@ Tests if a value is a member of a tuple: ## Join [tagjoin]: # (join) -Join two lists together: +Join two tuples together: var t1 = (1,2,3), t2 = (4, 5, 6) print t1.join(t2) // expect: (1,2,3,4,5,6) + +## Sort +[tagsort]: # (sort) + +Sorts the contents of a tuple into ascending order, returning a new tuple: + + var tuple = (4,3,2,1) + print tuple.sort() // prints (1, 2, 3, 4) + +You can provide your own function to use to compare values in the tuple: + + tuple.sort(fn (a, b) a-b) + +This function should return a negative value if `ab` and `0` if `a` and `b` are equal. + +## Order +[tagorder]: # (order) + +Returns a tuple of indices that would, if used in order, sort a tuple. For example + + var tuple = (2,3,1) + print tuple.order() // prints (2,0,1) + +would produce `(2,0,1)`. + +## Reverse +[tagreverse]: # (reverse) + +Returns a reversed copy of a tuple, leaving the original unchanged: + + var tuple = (1,2,3) + print tuple.reverse() // prints (3,2,1) + +## Roll +[tagroll]: # (roll) + +Returns a copy of a tuple with its contents rolled by a specified number of positions, leaving the original unchanged: + + var tuple = (1,2,3) + print tuple.roll(1) // prints (3,1,2) + print tuple.roll(-1) // prints (2,3,1) + +## tostring +[tagtostring]: # (tostring) + +Converts a tuple to a string: + + var tuple = (1,2,3) + print tuple.tostring() // prints (1, 2, 3) diff --git a/help/variables.md b/help/variables.md index ad53df9ec..05159bbe1 100644 --- a/help/variables.md +++ b/help/variables.md @@ -35,6 +35,8 @@ Multiple variables can be defined at once by separating them with commas where each can have its own initializer (or not). +[showsubtopics]: # (subtopics) + ## Indexing [taglb]: # ([) [tagrb]: # (]) diff --git a/modules/graphics.morpho b/modules/graphics.morpho index c7edd7b58..bd8d84876 100644 --- a/modules/graphics.morpho +++ b/modules/graphics.morpho @@ -1,4 +1,9 @@ -/* Graphics */ +/* Graphics + * + * History: + * 1/7/25 Redirect error output to /dev/null to suppress errors on macOS + * 1/2/26 Windows compatibility + */ import constants import meshtools @@ -589,22 +594,28 @@ class Graphics { **************************************** */ class Show { - init(g) { + var isWindows = System.platform()=="windows" + self.uidinit() self.spheres = Dictionary() self.fonts = [] self.colors = Dictionary() - var tempfolder = "/tmp" + var tempfolder = (isWindows ? "${System.homefolder()}\\AppData\\local\\Temp" : "/tmp") var fname = self._randomalphanumstring(10) var out = File("${tempfolder}/morpho${fname}.draw", "w") self.write(g, out) out.close() - // 1/7/25 Redirect error output to /dev/null to suppress annoying errors on macOS - system("morphoview -t ${tempfolder}/morpho${fname}.draw > /dev/null 2>&1 &") + + if (isWindows) { + system("powershell -Command \"Start-Process 'morphoview' -ArgumentList '-t', '${tempfolder}/morpho${fname}.draw' -WindowStyle Hidden\"") + } else { + // 1/7/25 Redirect error output to /dev/null + system("morphoview -t ${tempfolder}/morpho${fname}.draw > /dev/null 2>&1 &") + } } /** Generate a random name */ @@ -719,6 +730,8 @@ class Show { var platform = System.platform() if (platform=="macos") { return ["/System/Library/Fonts"] + } else if (platform=="windows") { + return ["C:/Windows/Fonts"] } else return ["/usr/share/fonts","/usr/local/share/fonts"] } @@ -755,6 +768,8 @@ class Show { var platform = System.platform() if (platform=="macos") { return "Helvetica" + } else if (platform=="windows") { + return "arial" // Note case sensitive } else return "FreeSans" } diff --git a/modules/meshtools.morpho b/modules/meshtools.morpho index 71a88095d..8599ee835 100644 --- a/modules/meshtools.morpho +++ b/modules/meshtools.morpho @@ -8,6 +8,7 @@ import constants import kdtree import delaunay +import functionals // Error messages var _errMshBldDimIncnstnt = Error("MshBldDimIncnstnt", "Vertex dimension inconsistent with mesh dimension.") @@ -27,6 +28,19 @@ var lineGrade = 1 var areaGrade = 2 var volumeGrade = 3 +// A fixed red refinement of a tetrahedron into four corner tets plus four +// tets that split the central octahedron along the (m01, m23) diagonal. +var _tetRedRefinement = [ + [0, 4, 5, 6], + [1, 4, 7, 8], + [2, 5, 7, 9], + [3, 6, 8, 9], + [4, 5, 6, 9], + [4, 5, 7, 9], + [4, 6, 8, 9], + [4, 7, 8, 9] +] + class MeshBuilder { init(dimension=nil) { self.vertices = [] @@ -327,6 +341,50 @@ fn _cmpel(a,b) { return true } +fn _canonel(el) { + var out = el.clone() + out.sort() + return apply(Tuple, out) +} + +fn _elementsubids(subdict, el, nsubverts) { + var nverts = el.count() + var expected = [] + + var counter[nsubverts], cmax[nsubverts] + for (i in 0...nsubverts) { + counter[i] = i + cmax[i] = nverts-nsubverts+i + } + + while (true) { + var subel = [] + for (i in 0...nsubverts) subel.append(el[counter[i]]) + + var key = _canonel(subel) + if (!subdict.contains(key)) return nil + expected.append(subdict[key]) + + if (counter[0] >= cmax[0]) break + + var k = nsubverts-1 + counter[k] += 1 + while (k>0 && counter[k]>cmax[k]) { + k -= 1 + counter[k] += 1 + } + for (i in k+1...nsubverts) counter[i] = counter[i-1]+1 + } + + return expected +} + +fn _subelementdict(conn, count) { + var out = Dictionary() + for (id in 0...count) out[_canonel(conn.rowindices(id))] = id + return out +} + // Determine if list a is already in a list of lists fn _elinlist(ellist, a) { for (el in ellist) { @@ -648,14 +706,66 @@ class MeshAdaptiveRefiner { // Subclasses should replace this method with their own version adaptmesh(selection) { } + _evalfield(field, oldmesh, elid, x) { + var lambda = oldmesh.barycentric(field.finiteElementSpace().grade(), elid, x) + return field.evalElement(elid, lambda) + } + + _point(lambda, vids, verts) { + var x = lambda[0]*verts.column(vids[0]) + for (j in 1...lambda.count()) x += lambda[j]*verts.column(vids[j]) + return x + } + + _setdof(field, dof, val) { + if (dof[0]==0) field[0, dof[1]] = val + else field[dof[0], dof[1], dof[2]] = val + } + + adaptfefield(field) { + if (!self.refinemap) return nil + + var fespace = field.finiteElementSpace() + var prototype = field.enumerate(0) + if (isobject(prototype)) prototype = prototype.clone() + if (!prototype) return nil + + var result = Field(self.new, prototype, grade=field.shape(), finiteelementspace=fespace) + var nodes = fespace.nodeCoords() + var oldmesh = self.mesh() + var newverts = self.new.vertexmatrix() + var newconn = self.new.connectivitymatrix(0, fespace.grade()) + var refineel = self.refinemap[fespace.grade()] + var done = Dictionary() + + for (newid in refineel) { + var oldid = refineel[newid] + var vids = newconn.rowindices(newid) + var dofs = result.elementDofs(newid) + + for (i in 0...fespace.count()) { + var dof = dofs[i] + if (done.contains(dof)) continue + + var x = self._point(nodes.column(i), vids, newverts) + var val = self._evalfield(field, oldmesh, oldid, x) + self._setdof(result, dof, val) + done[dof] = true + } + } + + return result + } + adaptfield(field) { // Maps a field onto a new mesh - var mesh = self.mesh() var prototype = field.enumerate(0) if (isobject(prototype)) prototype=prototype.clone() var shape = field.shape() - var fespace = field.finiteelementspace() + var fespace = field.finiteElementSpace() var result + if (fespace) return self.adaptfefield(field) + if (self.refinemap && prototype) { result = Field(self.new, prototype, grade=shape, finiteelementspace=fespace) @@ -865,51 +975,53 @@ class MeshRefiner is MeshAdaptiveRefiner { } refine3(id, el, vert, nel, dict) { // refine volumes - var nv = el.count() // Number of vertices in the element - var pts = [] // Points defining the element - var localmap = Dictionary() // Maps local ids in pts to correct ids - - for (i in 0...nv) { // Find vertex positions and ids - pts.append(vert.column(el[i])) - localmap[i]=el[i] + fn _pairkey(i, j) { + if (i0) { + for (e in subtet.sets(2)) self.addelement(id, lineGrade, e, nil) + } + + if (nel[2]>0) { + for (e in subtet.sets(3)) self.addelement(id, areaGrade, e, nil) } } return true @@ -1155,3 +1267,167 @@ class MeshPruner is MeshAdaptiveRefiner { return self.adapt(selection=selection) } } + +/* ********************************** + * MeshChecker + * ********************************** */ + +class MeshChecker { + init(mesh, quiet=false) { + self.mesh = mesh + self.sizetol = 1e-4 + self.quiet=quiet + } + + _functionalForGrade(grade) { + if (grade==1) return Length + if (grade==2) return Area + if (grade==3) return Volume + } + + _connectivitywarning(grade, id, subgrade) { + Error("MshElCnn", + "Grade ${grade} element ${id} has inconsistent grade ${subgrade} connectivity").warning() + } + + countElements() { + for (grade in 0..self.mesh.maxgrade()) { + print "Grade ${grade}: ${self.mesh.count(grade)} elements" + } + } + + checkElementDim() { + for (grade in 1..self.mesh.maxgrade()) { + var conn = self.mesh.connectivitymatrix(0,grade) + if (!conn) continue + + var nel = conn.dimensions()[1] + for (id in 0...nel) { + if (conn.rowindices(id).count()!=grade+1) { + Error("MshElDim", "Grade ${grade}, element ${id} has ${conn.rowindices(id).count()} vertices").warning() + } + } + } + } + + checkDuplicateVertices() { + if (self.mesh.count()==0) return + var x0 = self.mesh.vertexposition(0) + + var tree = KDTree([x0]) + + for (id in 1...self.mesh.count()) { + var x = self.mesh.vertexposition(id) + var nearest = (tree.nearest(x).location - x).norm() + if (nearest < self.sizetol) { + Error("MshDupVtx", "Duplicate vertex ${id} [${nearest}]").warning() + } + + var node = tree.insert(x) + node.id = id + } + } + + checkDuplicateElements() { + for (grade in 1..self.mesh.maxgrade()) { + var conn = self.mesh.connectivitymatrix(0,grade) + if (!conn) continue + + var dict = {} + var nel = conn.dimensions()[1] + + for (id in 0...nel) { + var ind = conn.rowindices(id) + ind.sort() + var el = apply(Tuple, ind) + + if (dict.contains(el)) { + Error("MshDup","Grade ${grade} id ${id} is a duplicate element of id ${dict[el]}").warning() + } else { + dict[el]=id + } + } + } + } + + checkElementConnectivity() { + for (grade in 2..self.mesh.maxgrade()) { + for (subgrade in 1...grade) { + var conn = self.mesh.connectivitymatrix(0, grade) + var subconn = self.mesh.connectivitymatrix(0, subgrade) + var relconn = self.mesh.connectivitymatrix(subgrade, grade) + var revconn = self.mesh.connectivitymatrix(grade, subgrade) + if (!conn || !subconn || !relconn || !revconn) continue + + var nsub = self.mesh.count(subgrade) + var subdict = _subelementdict(subconn, nsub) + + for (id in 0...self.mesh.count(grade)) { + var el = conn.rowindices(id) + var expected = _elementsubids(subdict, el, subgrade+1) + if (!expected) { + self._connectivitywarning(grade, id, subgrade) + continue + } + + var actual = relconn.rowindices(id).clone() + actual.sort() + expected.sort() + + if (!_cmpel(actual, expected)) { + self._connectivitywarning(grade, id, subgrade) + continue + } + + for (subid in actual) { + if (!revconn.rowindices(subid).ismember(id)) { + self._connectivitywarning(grade, id, subgrade) + break + } + } + } + + for (subid in 0...nsub) { + for (id in revconn.rowindices(subid)) { + if (!relconn.rowindices(id).ismember(subid)) { + self._connectivitywarning(subgrade, subid, grade) + break + } + } + } + } + } + } + + checkElementSize() { + var dict = {} + + for (grade in 1..self.mesh.maxgrade()) { + if (self.mesh.count(grade)==0) continue + + var func = self._functionalForGrade(grade) + if (!func) continue + + var sizes = func().integrand(self.mesh) + var glist = [] + + for (size, id in sizes) { + if (size<=self.sizetol) { + Error("MshZroSz", "Grade ${grade} element ${id} has non-positive size [${size}]").warning() + glist.append(id) + } + } + dict[grade] = glist + } + return dict + } + + check() { + if (!self.quiet) print "Checking mesh..." + self.checkElementDim() + self.checkElementConnectivity() + self.checkElementSize() + self.checkDuplicateVertices() + self.checkDuplicateElements() + } +} diff --git a/releasenotes/version-0.6.4.md b/releasenotes/version-0.6.4.md new file mode 100644 index 000000000..1aee82032 --- /dev/null +++ b/releasenotes/version-0.6.4.md @@ -0,0 +1,47 @@ +# Release notes for 0.6.4 + +We're pleased to announce Morpho 0.6.4, which contains many significant improvements and is the first release available natively on Windows. + +## New linear algebra implementation + +The linear algebra package in morpho has been rewritten to support complex matrices as well as a more extensible implementation that should support other matrix types in future. These still use the BLAS and LAPACK numerical libraries, but more underlying capability is exposed. Both the `Matrix` and `ComplexMatrix` now support additional matrix decompositions, such as QR decomposition and SVD. The new implementation is highly compatible with existing code; in a few cases alternative error messages are generated and results are returned in Tuples rather than Lists. + +## Additional finite elements + +In addition to the existing CG1 and CG2 implementations, morpho now supports a third order Lagrangian element CG3; this is valuable for problems involving hessians, for example. Support in the codebase for higher order elements has been improved, e.g. `MeshRefiner` is now able to refine a `Field` using these elements correctly. The `FiniteElementSpace` class now exposes additional information about a particular finite element to the user. + +Interior penalty schemes are now available through a `Jump` functional, which integrates over the join between two connected elements. See the `jump` documentation for more details. (This feature is experimental). + +## Additional functionality available within integrand functions + +Functions passed to `LineIntegral`, `AreaIntegral` and `VolumeIntegral` may call some special functions to access additional information: + + * `elementid` returns the id of the current element + * `hessian` returns the local hessian of a field + * `jacobian` returns the jacobian of the map from the reference element to the current element. + * `invjacobian` returns the inverse jacobian. + +## Improved type checking within the compiler + +The morpho compiler now allows variables to be declared with a distinct type, e.g. + + String s = "Hello" + +and enforces these through a combination of static and runtime checks. Assignment of an incorrect type to a typed variable yields a type error. The compiler is able to infer many types automatically across arithmetic operations, function calls etc. A few new classes have been added, e.g. `Callable`, to assist in writing functions using multiple dispatch. + +## Improvements to help system + +The core help system has been moved from the terminal app to the morpho library, facilitating access by other interfaces. An improved markdown parser enables richer help entries. Enhanced search capabilities: the help system now provides a hint if there are multiple matches, and possible matches if there are none (e.g. if the user misspells something). Help text can now be retrieved programmatically using `System.help`. + +## Folder improvements + +New class methods `Folder.create` and `Folder.createRecursive` allow creation of new folders. The class method `Folder.normalizePath` converts a file path with arbitrary folder delimiters to the correct ones for the current platform. + +## Minor fixes + +* Bug in `System.setworkingfolder` fixed. +* Rewritten multiple dispatch implementation fixes edge-cases in method resolution. +* Improved test suite coverage. +* graphics package updated to support Windows fonts. +* Improvements to `Tuple` class to better match `List`'s capabilities. +* Fixed a problem with building morpho on ARM64 linux. \ No newline at end of file diff --git a/src/build.h b/src/build.h index 9c8e12c7a..51cd72d61 100644 --- a/src/build.h +++ b/src/build.h @@ -10,11 +10,11 @@ * Version * ********************************************************************** */ -#define MORPHO_VERSIONSTRING "0.6.3" +#define MORPHO_VERSIONSTRING "0.6.4" #define MORPHO_VERSION_MAJOR 0 #define MORPHO_VERSION_MINOR 6 -#define MORPHO_VERSION_PATCH 3 +#define MORPHO_VERSION_PATCH 4 /* ********************************************************************** * Paths and file system @@ -123,15 +123,18 @@ * Core library [options set in CMake] * ********************************************************************** */ -/** Build with Matrix class using BLAS/LAPACK */ +/** @brief Build with Matrix class using BLAS/LAPACK */ //#define MORPHO_INCLUDE_LINALG -/** Build with Sparse class */ +/** @brief Build with Sparse class */ //#define MORPHO_INCLUDE_SPARSE -/** Build with geometry classes */ +/** @brief Build with geometry classes */ //#define MORPHO_INCLUDE_GEOMETRY +/** @brief Build with new help system */ +#define MORPHO_INCLUDE_HELP + /* ********************************************************************** * Libraries * ********************************************************************** */ @@ -185,4 +188,6 @@ //#define MORPHO_OPCODE_USAGE /** @brief Buiild with profile support */ -#define MORPHO_PROFILER +#ifdef _DEBUG_PROFILER + #define MORPHO_PROFILER +#endif diff --git a/src/builtin/builtin.c b/src/builtin/builtin.c index d49a274c4..19e4b0d8b 100644 --- a/src/builtin/builtin.c +++ b/src/builtin/builtin.c @@ -4,6 +4,8 @@ * @brief Morpho built in functions and classes */ +#include + #include "builtin.h" #include "common.h" #include "object.h" @@ -15,6 +17,8 @@ #include "sparse.h" #include "geometry.h" +extern objecttypedefn objectmetafunctiondefn; + /* ********************************************************************** * Global data * ********************************************************************** */ @@ -50,7 +54,7 @@ void builtin_init(objectbuiltinfunction *func) { /** Clear an objectbuiltinfunction */ void builtin_clear(objectbuiltinfunction *func) { - morpho_freeobject(func->name); + if (MORPHO_ISOBJECT(func->name)) object_freeifunmanaged(MORPHO_GETOBJECT(func->name)); signature_clear(&func->sig); } @@ -124,15 +128,6 @@ bool builtin_options(vm *v, int nargs, value *args, int *nfixed, int noptions, . return true; } -/** Tests whether an object is callable */ -bool builtin_iscallable(value val) { - return (MORPHO_ISOBJECT(val) && (MORPHO_ISFUNCTION(val) || - MORPHO_ISCLOSURE(val) || - MORPHO_ISINVOCATION(val) || - MORPHO_ISBUILTINFUNCTION(val) || - MORPHO_ISMETAFUNCTION(val))); -} - /* ********************************************************************** * object_builtinfunction definition * ********************************************************************** */ @@ -160,6 +155,39 @@ objecttypedefn objectbuiltinfunctiondefn = { .cmpfn=NULL }; +/* ********************************************************************** + * Signature parsing + * ********************************************************************** */ + +/** This mechanism allows builtin classes to cross-reference one another in method signature declarations */ + +typedef struct _sigparses { + const char *sig; + signature *dest; +} _sigparse; + +DECLARE_VARRAY(_sigparse, _sigparse) +DEFINE_VARRAY(_sigparse, _sigparse) + +varray__sigparse sigparseworklist; + +/** Add a signature to be parsed on the next call to builtin_parsesignatures */ +void builtin_addparsesignature(const char *sig, signature *dest) { + _sigparse s = { .sig = sig, .dest = dest }; + varray__sigparsewrite(&sigparseworklist, s); +} + +/** Parses all signatures on the worklist */ +bool builtin_parsesignatures(void) { + _sigparse s; + while (varray__sigparsepop(&sigparseworklist, &s)) { + if (!signature_parse(s.sig, s.dest)) { + return false; + } + } + return true; +} + /* ********************************************************************** * Create and find builtin functions * ********************************************************************** */ @@ -184,7 +212,7 @@ void builtin_setclasstable(dictionary *dict) { _currentclasstable=dict; } -/** Add a builtin function. +/** Add a builtin function (old interface) * @param name name of the function * @param func the corresponding C function * @param flags flags to define the function @@ -215,28 +243,30 @@ objectclass *builtin_getparentclass(value fn) { * @param[in] dict the dictionary * @param[in] name name of the function to add * @param[in] fn function to add + * @param[in] forcewrap force wrapping the incoming function on first insert * @param[out] out the function added (which may be a metafunction) * @returns true on success */ -bool builtin_addfunctiontodict(dictionary *dict, value name, value fn, value *out) { +bool builtin_addfunctiontodict(dictionary *dict, value name, value fn, bool forcewrap, value *out) { bool success=false; - value entry=fn; // Dictionary entry for this name + value entry=MORPHO_NIL, prev=MORPHO_NIL, incoming=fn; value selector = dictionary_intern(&builtin_symboltable, name); // Use interned name - - if (dictionary_get(dict, selector, &entry)) { // There was an existing function - if (MORPHO_ISBUILTINFUNCTION(entry)) { // It was a builtinfunction, so we need to create a metafunction - if (builtin_getparentclass(fn) != - MORPHO_GETBUILTINFUNCTION(entry)->klass) { // Override superclass methods for now - dictionary_insert(dict, selector, fn); - } else if (metafunction_wrap(name, entry, &entry)) { // Wrap the old definition in a metafunction - - builtin_bindobject(MORPHO_GETOBJECT(entry)); - metafunction_add(MORPHO_GETMETAFUNCTION(entry), fn); // Add the new definition - success=dictionary_insert(dict, selector, entry); - } - } else if (MORPHO_ISMETAFUNCTION(entry)) { // It was already a metafunction so simply add the new function - success=metafunction_add(MORPHO_GETMETAFUNCTION(entry), fn); + objectclass *klass = builtin_getparentclass(fn); + + if (dictionary_get(dict, selector, &prev) && klass != builtin_getparentclass(prev)) { // Override superclass methods for now + entry=fn; + success=dictionary_insert(dict, selector, entry); + } else { + if (MORPHO_ISNIL(prev) && forcewrap) { + if (!metafunction_wrap(name, fn, &incoming)) return false; } - } else success=dictionary_insert(dict, selector, fn); + + success=metafunction_merge(name, prev, incoming, klass, &entry); + if (success && MORPHO_ISMETAFUNCTION(entry)) { + metafunction_setclass(MORPHO_GETMETAFUNCTION(entry), klass); + if (!MORPHO_ISSAME(prev, entry)) builtin_bindobject(MORPHO_GETOBJECT(entry)); + } + if (success) success=dictionary_insert(dict, selector, entry); + } if (success && out) *out = entry; @@ -259,17 +289,20 @@ bool morpho_addfunction(char *name, char *signature, builtinfunction func, built new->flags=flags; new->name=object_stringfromcstring(name, strlen(name)); - if (!name) goto morpho_addfunction_cleanup; + if (!MORPHO_ISSTRING(new->name)) goto morpho_addfunction_cleanup; // Parse function signature if provided - if (signature && - !signature_parse(signature, &new->sig)) { - UNREACHABLE("Syntax error in signature definition."); - } + if (signature) builtin_addparsesignature(signature, &new->sig); + + value selector = dictionary_intern(&builtin_symboltable, new->name); + if (MORPHO_ISNIL(selector)) goto morpho_addfunction_cleanup; + if (!MORPHO_ISSAME(selector, new->name)) morpho_freeobject(new->name); + new->name=selector; + builtin_bindobject(MORPHO_GETOBJECT(selector)); value newfn = MORPHO_OBJECT(new); - if (!builtin_addfunctiontodict(_currentfunctiontable, new->name, newfn, NULL)) { + if (!builtin_addfunctiontodict(_currentfunctiontable, new->name, newfn, signature!=NULL, NULL)) { UNREACHABLE("Redefinition of function in same extension [in builtin.c]"); } @@ -281,13 +314,24 @@ bool morpho_addfunction(char *name, char *signature, builtinfunction func, built morpho_addfunction_cleanup: if (new) { - builtin_clear(new); object_free((object *) new); } return false; } +/** Finalize any open metafunctions from the C objects list */ +bool builtin_finalizemetafunctions(void) { + error err; + error_init(&err); + if (!metafunction_finalizelist(builtin_objects, &err)) { + UNREACHABLE("Unable to finalize builtin metafunctions."); + } + error_clear(&err); + + return true; +} + /* ********************************************************************** * Create and find builtin classes * ********************************************************************** */ @@ -295,22 +339,39 @@ bool morpho_addfunction(char *name, char *signature, builtinfunction func, built /** Defines a built in class * @param[in] name the name of the class * @param[in] desc class description; use MORPHO_GETCLASSDEFINITION(name) to obtain this - * @param[in] superclass the class's superclass - * @returns the class object */ -value builtin_addclass(char *name, builtinclassentry desc[], value superclass) { + * @param[in] nparents number of parent classes + * @param[in] parents the parent classes + * @param[out] out the class object + * @returns true on success */ +bool morpho_addclass(char *name, builtinclassentry desc[], int nparents, value *parents, value *out) { value label = object_stringfromcstring(name, strlen(name)); builtin_bindobject(MORPHO_GETOBJECT(label)); objectclass *new = object_newclass(label); builtin_bindobject((object *) new); - objectclass *superklass = NULL; + bool success=true; + + if (!new) return false; + + if (dictionary_get(_currentclasstable, label, NULL)) { + UNREACHABLE("Redefinition of class in same extension [in builtin.c]"); + } - if (!new) return MORPHO_NIL; + dictionary_insert(_currentclasstable, label, MORPHO_OBJECT(new)); /** Copy methods from superclass */ - if (MORPHO_ISCLASS(superclass)) { - superklass = MORPHO_GETCLASS(superclass); - dictionary_copy(&superklass->methods, &new->methods); - new->superclass=superklass; + for (int i=0; imethods, &new->methods); + if (i==0) new->superclass=parentclass; + varray_valuewrite(&new->parents, parents[i]); + varray_valuewrite(&parentclass->children, MORPHO_OBJECT(new)); + } + } + + /** Compute the class linearization */ + if (!class_linearize(new)) { + UNREACHABLE("Class definition not linearizable."); } for (unsigned int i=0; desc[i].name!=NULL; i++) { @@ -320,36 +381,56 @@ value builtin_addclass(char *name, builtinclassentry desc[], value superclass) { newmethod->function=desc[i].function; newmethod->klass=new; newmethod->name=object_stringfromcstring(desc[i].name, strlen(desc[i].name)); + if (!MORPHO_ISSTRING(newmethod->name)) { success=false; break; } newmethod->flags=desc[i].flags; - if (desc[i].signature) { - signature_parse(desc[i].signature, &newmethod->sig); - } + if (desc[i].signature) builtin_addparsesignature(desc[i].signature, &newmethod->sig); - dictionary_intern(&builtin_symboltable, newmethod->name); + value selector = dictionary_intern(&builtin_symboltable, newmethod->name); + if (MORPHO_ISNIL(selector)) { + object_free((object *) newmethod); + success=false; + break; + } + if (!MORPHO_ISSAME(selector, newmethod->name)) morpho_freeobject(newmethod->name); + newmethod->name=selector; + builtin_bindobject(MORPHO_GETOBJECT(selector)); value method = MORPHO_OBJECT(newmethod); builtin_bindobject((object *) newmethod); - builtin_addfunctiontodict(&new->methods, newmethod->name, method, NULL); + builtin_addfunctiontodict(&new->methods, newmethod->name, method, desc[i].signature!=NULL, NULL); } } - if (dictionary_get(_currentclasstable, label, NULL)) { - UNREACHABLE("Redefinition of class in same extension [in builtin.c]"); - } - - dictionary_insert(_currentclasstable, label, MORPHO_OBJECT(new)); - - return MORPHO_OBJECT(new); + if (success)*out = MORPHO_OBJECT(new); + return success; } -/** Finds a builtin class from its name */ +/** Defines a built in class (old interface) + * @param[in] name the name of the class + * @param[in] desc class description; use MORPHO_GETCLASSDEFINITION(name) to obtain this + * @param[in] superclass the class's superclass + * @returns the class object */ +value builtin_addclass(char *name, builtinclassentry desc[], value superclass) { + value out = MORPHO_NIL; + morpho_addclass(name, desc, 1, &superclass, &out); + return out; +} + +/** Finds a builtin class from its label */ value builtin_findclass(value name) { value out=MORPHO_NIL; - dictionary_get(&builtin_classtable, name, &out); + if (_currentclasstable) dictionary_get(_currentclasstable, name, &out); + if (MORPHO_ISNIL(out)) dictionary_get(&builtin_classtable, name, &out); return out; } +/** Finds a builtin class from a cstring label */ +value builtin_findclassfromcstring(char *label) { + objectstring objname = MORPHO_STATICSTRING(label); + return builtin_findclass(MORPHO_OBJECT(&objname)); +} + /** Copies the built in symbol table into a new dictionary */ void builtin_copysymboltable(dictionary *out) { dictionary_copy(&builtin_symboltable, out); @@ -393,15 +474,24 @@ void builtin_initialize(void) { builtin_setclasstable(&builtin_classtable); // Initialize core object types - objectstringtype=object_addtype(&objectstringdefn); objectclasstype=object_addtype(&objectclassdefn); + objectstringtype=object_addtype(&objectstringdefn); objectbuiltinfunctiontype=object_addtype(&objectbuiltinfunctiondefn); + objectmetafunctiontype=object_addtype(&objectmetafunctiondefn); + varray__sigparseinit(&sigparseworklist); + /* Initialize builtin classes and functions */ instance_initialize(); // Must initialize first so that Object exists + float_initialize(); // Veneer classes + int_initialize(); + bool_initialize(); + nil_initialize(); + string_initialize(); // Classes function_initialize(); + cfunction_initialize(); metafunction_initialize(); class_initialize(); upvalue_initialize(); @@ -415,10 +505,6 @@ void builtin_initialize(void) { err_initialize(); tuple_initialize(); - float_initialize();// Veneer classes - int_initialize(); - bool_initialize(); - file_initialize(); system_initialize(); json_initialize(); @@ -428,7 +514,7 @@ void builtin_initialize(void) { // Initialize linear algebra #ifdef MORPHO_INCLUDE_LINALG - matrix_initialize(); + linalg_initialize(); #endif #ifdef MORPHO_INCLUDE_SPARSE @@ -439,7 +525,13 @@ void builtin_initialize(void) { // Initialize geometry geometry_initialize(); #endif - + + if (!builtin_parsesignatures()) { + UNREACHABLE("Syntax error in signature."); + } + + builtin_finalizemetafunctions(); + morpho_addfinalizefn(builtin_finalize); } @@ -450,6 +542,8 @@ void builtin_finalize(void) { builtin_objects=next; } + varray__sigparseclear(&sigparseworklist); + dictionary_clear(&builtin_functiontable); dictionary_clear(&builtin_classtable); dictionary_clear(&builtin_symboltable); diff --git a/src/builtin/builtin.h b/src/builtin/builtin.h index 46b13cc8e..ff5f5fc1a 100644 --- a/src/builtin/builtin.h +++ b/src/builtin/builtin.h @@ -16,6 +16,9 @@ #include "signature.h" +/** Call to pase method and function signatures */ +bool builtin_parsesignatures(void); + /* ------------------------------------------------------- * Built in function objects * ------------------------------------------------------- */ @@ -23,13 +26,34 @@ /** Flags that describe properties of the built in function */ typedef unsigned int builtinfunctionflags; -#define BUILTIN_FLAGSEMPTY 0 - -#define MORPHO_FN_FLAGSEMPTY (0) -#define MORPHO_FN_PUREFN (1<<1) -#define MORPHO_FN_CONSTRUCTOR (1<<2) -#define MORPHO_FN_REENTRANT (1<<3) -#define MORPHO_FN_OPTARGS (1<<4) +/* Annotation policy: + * - MORPHO_FN_FLAGSEMPTY means unknown or legacy-unreviewed; optimizers should stay conservative. + * - MORPHO_FN_NONE means the function has been reviewed and has no special semantic annotation. + * - MORPHO_FN_PUREFN means pure on normal return: deterministic for constant inputs with no mutation, + * I/O, VM re-entry, thread-local dependence, or multithreaded execution. + * - Functions that allocate returned objects should generally carry MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS, + * because object construction / wrap-and-bind may fail. + * - MORPHO_FN_MUTATES is reserved for externally observable mutation, not internal caching. + * - MORPHO_FN_IO includes reads from process, filesystem, or platform state. + * - MORPHO_FN_NONDETERMINISTIC is reserved for genuinely unstable results such as RNG-like behavior. + */ + +#define MORPHO_FN_FLAGSEMPTY (0) // Unknown or legacy-unreviewed flags: optimizer should assume any annotation may apply +#define MORPHO_FN_NONE (1<<0) // Function has been reviewed and has no special semantic annotations + +#define BUILTIN_FLAGSEMPTY MORPHO_FN_FLAGSEMPTY + +#define MORPHO_FN_PUREFN (1<<1) // Pure on normal return: deterministic for constant inputs, no mutation, I/O or re-entry +#define MORPHO_FN_CONSTRUCTOR (1<<2) // Constructor function +#define MORPHO_FN_REENTRANT (1<<3) // Function that re-enters the vm, e.g. by using morpho_call +#define MORPHO_FN_OPTARGS (1<<4) // Function reads VM optional/named arguments +#define MORPHO_FN_THROWS (1<<5) // Function may raise a runtime error +#define MORPHO_FN_ALLOCATES (1<<6) // Function may allocate and return/bind new objects +#define MORPHO_FN_MUTATES (1<<7) // Function may mutate receiver, arguments, or runtime-visible state +#define MORPHO_FN_IO (1<<8) // Function performs externally observable I/O or system interaction +#define MORPHO_FN_NONDETERMINISTIC (1<<9) // Function may return different results for the same inputs +#define MORPHO_FN_THREADLOCAL (1<<10) // Function depends on or mutates VM thread-local state +#define MORPHO_FN_MULTITHREADED (1<<11) // Function may execute work across multiple threads /** Type of C function that implements a built in Morpho function */ typedef value (*builtinfunction) (vm *v, int nargs, value *args); @@ -124,9 +148,11 @@ value builtin_addfunction(char *name, builtinfunction func, builtinfunctionflags value builtin_findfunction(value name); bool morpho_addfunction(char *name, char *signature, builtinfunction func, builtinfunctionflags flags, value *out); +bool builtin_finalizemetafunctions(void); value builtin_addclass(char *name, builtinclassentry desc[], value superclass); value builtin_findclass(value name); +value builtin_findclassfromcstring(char *label); void builtin_copysymboltable(dictionary *out); @@ -135,19 +161,17 @@ value builtin_internsymbolascstring(char *symbol); bool builtin_checksymbol(value symbol); bool builtin_options(vm *v, int nargs, value *args, int *nfixed, int noptions, ...); -bool builtin_iscallable(value val); - bool builtin_enumerateloop(vm *v, value obj, builtin_loopfunction fn, void *ref); /* ------------------------------------------------------- * Veneer classes * ------------------------------------------------------- */ -void object_setveneerclass(objecttype type, value class); +void object_setveneerclass(objecttype type, value klass); objectclass *object_getveneerclass(objecttype type); bool object_veneerclasstotype(objectclass *clss, objecttype *type); -void value_setveneerclass(value type, value class); +void value_setveneerclass(value type, value klass); objectclass *value_getveneerclass(value type); objectclass *value_veneerclassfromtype(int type); bool value_veneerclasstotype(objectclass *clss, int *type); diff --git a/src/builtin/functiondefs.c b/src/builtin/functiondefs.c index b644ee513..5f814b948 100644 --- a/src/builtin/functiondefs.c +++ b/src/builtin/functiondefs.c @@ -14,7 +14,7 @@ #include "common.h" #include "cmplx.h" -#include "matrix.h" +#include "linalg.h" #include "sparse.h" #include "mesh.h" @@ -30,27 +30,207 @@ * ********************************************************************** */ /* ************************************ - * Math + * System + * *************************************/ + +/** Call the operating system */ +value builtin_system(vm *v, int nargs, value *args) { + if (nargs==1) { + value arg=MORPHO_GETARG(args, 0); + if (MORPHO_ISSTRING(arg)) { + return MORPHO_INTEGER(system(MORPHO_GETCSTRING(arg))); + } + } + return MORPHO_NIL; +} + +/** Clock */ +value builtin_clock(vm *v, int nargs, value *args) { + clock_t time; + time = clock(); + return MORPHO_FLOAT( ((double) time)/((double) CLOCKS_PER_SEC) ); +} + +/* ************************************ + * Apply + * *************************************/ + +static value builtin_apply__tuple(vm *v, int nargs, value *args) { + value ret = MORPHO_NIL; + objecttuple *t = MORPHO_GETTUPLE(MORPHO_GETARG(args, 1)); + morpho_call(v, MORPHO_GETARG(args, 0), tuple_length(t), t->tuple, &ret); + return ret; +} + +static value builtin_apply__list(vm *v, int nargs, value *args) { + value ret = MORPHO_NIL; + objectlist *lst = MORPHO_GETLIST(MORPHO_GETARG(args, 1)); + morpho_call(v, MORPHO_GETARG(args, 0), list_length(lst), lst->val.data, &ret); + return ret; +} + +/** Apply a function to a list of arguments */ +value builtin_apply(vm *v, int nargs, value *args) { + value ret = MORPHO_NIL; + morpho_call(v, MORPHO_GETARG(args, 0), nargs-1, &MORPHO_GETARG(args, 1), &ret); + return ret; +} + +static value builtin_apply__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, APPLY_ARGS); + return MORPHO_NIL; +} + +/* ************************************ + * Random numbers * *************************************/ -#define BUILTIN_MATH(function) \ -value builtin_##function(vm *v, int nargs, value *args) { \ - if (nargs==1) { \ - value arg = MORPHO_GETARG(args, 0); \ - if (MORPHO_ISFLOAT(arg)) { \ - return MORPHO_FLOAT(function(MORPHO_GETFLOATVALUE(arg))); \ - } else if (MORPHO_ISINTEGER(arg)) { \ - return MORPHO_FLOAT(function((double) MORPHO_GETINTEGERVALUE(arg))); \ - } else if (MORPHO_ISCOMPLEX(arg)){\ - return complex_builtin##function(v,MORPHO_GETCOMPLEX(arg));\ - } else { \ - morpho_runtimeerror(v, MATH_ARGS, #function);\ - } \ - } \ - morpho_runtimeerror(v, MATH_NUMARGS, #function);\ - return MORPHO_NIL; \ +/** Generate a random float between 0 and 1 */ +value builtin_random(vm *v, int nargs, value *args) { + return MORPHO_FLOAT(random_double()); +} + +/** Generate a random integer with a bound. + Efficient and unbiased algorithm from: https://www.pcg-random.org/posts/bounded-rands.html */ +value builtin_randomint_norange(vm *v, int nargs, value *args) { + uint32_t x = random_int(); + return MORPHO_INTEGER((int) x); +} + +value builtin_randomint(vm *v, int nargs, value *args) { + uint32_t x = random_int(); + + /* Generate a number in range. */ + int r=0; + if (!morpho_valuetoint(MORPHO_GETARG(args, 0), &r)||r<0) { + morpho_runtimeerror(v, VM_INVALIDARGSDETAIL,FUNCTION_RANDOMINT, 1, "positive integer"); + } + + uint32_t range=(uint32_t) r; + uint64_t m = (uint64_t) x * (uint64_t) range; + uint32_t l = (uint32_t) m; + + if (l < range) { + uint32_t t = -range; + if (t >= range) { + t -= range; + if (t >= range) + t %= range; + } + while (l < t) { + x = random_int(); + m = (uint64_t) x * (uint64_t) range; + l = (uint32_t) m; + } + } + return MORPHO_INTEGER(m >> 32); +} + +/** Generate a random normally distributed number */ +value builtin_randomnormal(vm *v, int nargs, value *args) { + double x,y,r; + + do { + x=2.0*random_double()-1.0; + y=2.0*random_double()-1.0; + + r=x*x+y*y; + } while (r>=1.0); + + return MORPHO_FLOAT(x*sqrt((-2.0*log(r))/r)); +} + +/* ************************************ + * Value constructors + * *************************************/ + +/** Convert something to an integer */ +value builtin_int__int(vm *v, int nargs, value *args) { + return MORPHO_GETARG(args, 0); +} + +value builtin_int__float(vm *v, int nargs, value *args) { + return MORPHO_FLOATTOINTEGER(MORPHO_GETARG(args, 0)); } +value builtin_int__string(vm *v, int nargs, value *args) { + value arg = MORPHO_GETARG(args, 0); + string_tonumber(MORPHO_GETSTRING(arg), &arg); + if (MORPHO_ISFLOAT(arg)) return MORPHO_FLOATTOINTEGER(arg); + else if (MORPHO_ISINTEGER(arg)) return arg; + + morpho_runtimeerror(v, MATH_NUMARGS, FUNCTION_INT); + return MORPHO_INTEGER(0); +} + +value builtin_int__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, MATH_NUMARGS, FUNCTION_INT); + return MORPHO_INTEGER(0); +} + +/** Convert to a floating point number */ +value builtin_float__int(vm *v, int nargs, value *args) { + return MORPHO_INTEGERTOFLOAT(MORPHO_GETARG(args, 0)); +} + +value builtin_float__float(vm *v, int nargs, value *args) { + return MORPHO_GETARG(args, 0); +} + +value builtin_float__string(vm *v, int nargs, value *args) { + value arg = MORPHO_GETARG(args, 0); + string_tonumber(MORPHO_GETSTRING(arg), &arg); + if (MORPHO_ISFLOAT(arg)) return arg; + else if (MORPHO_ISINTEGER(arg)) return MORPHO_INTEGERTOFLOAT(arg); + + morpho_runtimeerror(v, MATH_NUMARGS, FUNCTION_FLOAT); + return MORPHO_INTEGER(0); +} + +value builtin_float__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, MATH_NUMARGS, FUNCTION_FLOAT); + return MORPHO_FLOAT(0.0); +} + +/** Convert to a boolean */ +value builtin_bool(vm *v, int nargs, value *args) { + return MORPHO_BOOL(MORPHO_ISTRUE(MORPHO_GETARG(args, 0))); +} + +value builtin_bool_err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, MATH_NUMARGS, FUNCTION_BOOL); + return MORPHO_FALSE; +} + +/* ************************************ + * Math + * *************************************/ + +#define BUILTIN_VARMATH(function, type) \ +value builtin_float_##function(vm *v, int nargs, value *args) { \ + value arg = MORPHO_GETARG(args, 0); \ + return type(function(MORPHO_GETFLOATVALUE(arg))); \ +} \ + \ +value builtin_int_##function(vm *v, int nargs, value *args) { \ + value arg = MORPHO_GETARG(args, 0); \ + return type(function((double) MORPHO_GETINTEGERVALUE(arg))); \ +} \ + \ +value builtin_cmplx_##function(vm *v, int nargs, value *args) { \ + value arg = MORPHO_GETARG(args, 0); \ + return complex_builtin##function(v, MORPHO_GETCOMPLEX(arg)); \ +} \ + \ +value builtin_numargserr_##function(vm *v, int nargs, value *args) { \ + morpho_runtimeerror(v, MATH_NUMARGS, #function); \ + return MORPHO_NIL; \ +} \ + +#define BUILTIN_MATH(function) BUILTIN_VARMATH(function, MORPHO_FLOAT) + +#define BUILTIN_MATH_BOOL(function) BUILTIN_VARMATH(function, MORPHO_BOOL) + /** Math functions */ BUILTIN_MATH(fabs) BUILTIN_MATH(exp) @@ -70,34 +250,18 @@ BUILTIN_MATH(tanh) BUILTIN_MATH(floor) BUILTIN_MATH(ceil) -#undef BUILTIN_MATH - -/** Boolean output function need to output morpho true or false **/ - -#define BUILTIN_MATH_BOOL(function) \ -value builtin_##function(vm *v, int nargs, value *args) { \ - if (nargs==1) { \ - value arg = MORPHO_GETARG(args, 0); \ - if (MORPHO_ISFLOAT(arg)) { \ - return MORPHO_BOOL(function(MORPHO_GETFLOATVALUE(arg))); \ - } else if (MORPHO_ISINTEGER(arg)) { \ - return MORPHO_BOOL(function((double) MORPHO_GETINTEGERVALUE(arg))); \ - } else if (MORPHO_ISCOMPLEX(arg)){\ - return complex_builtin##function(MORPHO_GETCOMPLEX(arg));\ - } else { \ - morpho_runtimeerror(v, MATH_ARGS, #function);\ - } \ - } \ - morpho_runtimeerror(v, MATH_NUMARGS, #function);\ - return MORPHO_NIL; \ -} - - BUILTIN_MATH_BOOL(isfinite) BUILTIN_MATH_BOOL(isinf) BUILTIN_MATH_BOOL(isnan) +#undef BUILTIN_VARMATH #undef BUILTIN_MATH_BOOL +#undef BUILTIN_MATH + +/* ************************************ + * Math functions with special cases + * *************************************/ + /** The sqrt function is needs to be able to return a complex number for negative arguments */ value builtin_sqrt(vm *v, int nargs, value *args) { if (nargs==1) { @@ -122,295 +286,146 @@ value builtin_sqrt(vm *v, int nargs, value *args) { } /** The arctan function is special; it can either take one or two arguments */ -value builtin_arctan(vm *v, int nargs, value *args) { - bool useComplex = false; - for (unsigned int i=0; i=0) { - return MORPHO_FLOAT(0); - } - else return MORPHO_FLOAT(M_PI); - } else if (MORPHO_ISCOMPLEX(arg)) { - objectcomplex *c=MORPHO_GETCOMPLEX(arg); - double val; - complex_angle(c,&val); - return MORPHO_FLOAT(val); - } - } - morpho_runtimeerror(v, MATH_NUMARGS, "angle"); - return MORPHO_NIL; +static value builtin_arctan__complex2(vm *v, int nargs, value *args) { + return complex_builtinatan2(v, MORPHO_GETARG(args, 1), MORPHO_GETARG(args, 0)); } -value builtin_conj(vm *v, int nargs, value *args) { - if (nargs==1) { - value arg = MORPHO_GETARG(args, 0); - if (MORPHO_ISNUMBER(arg)) { - return arg; - } else if (MORPHO_ISCOMPLEX(arg)) { - objectcomplex *a=MORPHO_GETCOMPLEX(arg); - value out=MORPHO_NIL; - objectcomplex *new = object_newcomplex(0,0); - if (new) { - complex_conj(a, new); - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } - return out; - } - } - morpho_runtimeerror(v, MATH_NUMARGS, "conj"); +static value builtin_arctan__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, MATH_NUMARGS, "arctan"); return MORPHO_NIL; } -/* ************************************ - * Random numbers - * *************************************/ +/** Remainder */ +value builtin_mod__int_int(vm *v, int nargs, value *args) { + value a = MORPHO_GETARG(args, 0); + value b = MORPHO_GETARG(args, 1); + return MORPHO_INTEGER(MORPHO_GETINTEGERVALUE(a) % MORPHO_GETINTEGERVALUE(b)); +} -/** Generate a random float between 0 and 1 */ -value builtin_random(vm *v, int nargs, value *args) { - return MORPHO_FLOAT(random_double()); +value builtin_mod__float_float(vm *v, int nargs, value *args) { + value a = MORPHO_GETARG(args, 0); + value b = MORPHO_GETARG(args, 1); + return MORPHO_FLOAT(fmod(MORPHO_GETFLOATVALUE(a), MORPHO_GETFLOATVALUE(b))); } -/** Generate a random normally distributed number */ -value builtin_randomnormal(vm *v, int nargs, value *args) { - double x,y,r; +value builtin_mod__int_float(vm *v, int nargs, value *args) { + return MORPHO_FLOAT(fmod((double) MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)), + MORPHO_GETFLOATVALUE(MORPHO_GETARG(args, 1)))); +} - do { - x=2.0*random_double()-1.0; - y=2.0*random_double()-1.0; - - r=x*x+y*y; - } while (r>=1.0); - - return MORPHO_FLOAT(x*sqrt((-2.0*log(r))/r)); +value builtin_mod__float_int(vm *v, int nargs, value *args) { + return MORPHO_FLOAT(fmod(MORPHO_GETFLOATVALUE(MORPHO_GETARG(args, 0)), + (double) MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)))); } -/** Generate a random integer with a bound. - Efficient and unbiased algorithm from: https://www.pcg-random.org/posts/bounded-rands.html */ -value builtin_randomint(vm *v, int nargs, value *args) { - uint32_t x = random_int(); - /* Leave quickly if no range was asked for */ - if (nargs==0) return MORPHO_INTEGER((int) x); - - /* Otherwise, generate a number in range. */ - int r=0; - if (!morpho_valuetoint(MORPHO_GETARG(args, 0), &r)||r<0) { - morpho_runtimeerror(v, VM_INVALIDARGSDETAIL,FUNCTION_RANDOMINT, 1, "positive integer"); - } - - uint32_t range=(uint32_t) r; - uint64_t m = (uint64_t) x * (uint64_t) range; - uint32_t l = (uint32_t) m; - - if (l < range) { - uint32_t t = -range; - if (t >= range) { - t -= range; - if (t >= range) - t %= range; - } - while (l < t) { - x = random_int(); - m = (uint64_t) x * (uint64_t) range; - l = (uint32_t) m; - } +value builtin_mod__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, VM_INVALIDARGS, 2, nargs); + return MORPHO_NIL; +} + +/** find the sign of a number */ +static value builtin_sign__value(vm *v, int nargs, value *args){ + double val; + if (!morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { + morpho_runtimeerror(v, MATH_ARGS, FUNCTION_SIGN); + return MORPHO_NIL; } - return MORPHO_INTEGER(m >> 32); + + if (val>0) return MORPHO_FLOAT(1); + if (val<0) return MORPHO_FLOAT(-1); + return MORPHO_FLOAT(0); } -/* ************************************ - * Type checking and conversion - * *************************************/ +static value builtin_sign__float(vm *v, int nargs, value *args){ + return builtin_sign__value(v, nargs, args); +} -/** Typecheck functions to test for the type of a quantity */ -#define BUILTIN_TYPECHECK(type, test) \ - value builtin_##type(vm *v, int nargs, value *args) { \ - if (nargs==1) { \ - return MORPHO_BOOL(test(MORPHO_GETARG(args, 0))); \ - } else morpho_runtimeerror(v, TYPE_NUMARGS, #type); \ - \ - return MORPHO_NIL; \ - } - -BUILTIN_TYPECHECK(isnil, MORPHO_ISNIL) -BUILTIN_TYPECHECK(isint, MORPHO_ISINTEGER) -BUILTIN_TYPECHECK(isfloat, MORPHO_ISFLOAT) -BUILTIN_TYPECHECK(isnumber, MORPHO_ISNUMBER) -BUILTIN_TYPECHECK(iscomplex, MORPHO_ISCOMPLEX) -BUILTIN_TYPECHECK(isbool, MORPHO_ISBOOL) -BUILTIN_TYPECHECK(isobject, MORPHO_ISOBJECT) -BUILTIN_TYPECHECK(isstring, MORPHO_ISSTRING) -BUILTIN_TYPECHECK(isclass, MORPHO_ISCLASS) -BUILTIN_TYPECHECK(isrange, MORPHO_ISRANGE) -BUILTIN_TYPECHECK(isdictionary, MORPHO_ISDICTIONARY) -BUILTIN_TYPECHECK(islist, MORPHO_ISLIST) -BUILTIN_TYPECHECK(istuple, MORPHO_ISTUPLE) -BUILTIN_TYPECHECK(isarray, MORPHO_ISARRAY) +static value builtin_sign__int(vm *v, int nargs, value *args){ + return builtin_sign__value(v, nargs, args); +} -#ifdef MORPHO_INCLUDE_LINALG -BUILTIN_TYPECHECK(ismatrix, MORPHO_ISMATRIX) -#endif +static value builtin_sign__err(vm *v, int nargs, value *args){ + morpho_runtimeerror(v, MATH_NUMARGS, FUNCTION_SIGN); + return MORPHO_NIL; +} -#ifdef MORPHO_INCLUDE_SPARSE -BUILTIN_TYPECHECK(issparse, MORPHO_ISSPARSE) -#endif +/* ************************************ + * Elementary complex functions + * *************************************/ -#ifdef MORPHO_INCLUDE_GEOMETRY -BUILTIN_TYPECHECK(ismesh, MORPHO_ISMESH) -BUILTIN_TYPECHECK(isselection, MORPHO_ISSELECTION) -BUILTIN_TYPECHECK(isfield, MORPHO_ISFIELD) -#endif +value builtin_real__number(vm *v, int nargs, value *args) { + return MORPHO_GETARG(args, 0); +} -#undef BUILTIN_TYPECHECK +value builtin_real__complex(vm *v, int nargs, value *args) { + objectcomplex *c=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); + double val; + complex_getreal(c,&val); + return MORPHO_FLOAT(val); +} -/** Check if something is callable */ -value builtin_iscallablefunction(vm *v, int nargs, value *args) { - if (nargs==1) { - if (builtin_iscallable(MORPHO_GETARG(args, 0))) return MORPHO_TRUE; - } else morpho_runtimeerror(v, TYPE_NUMARGS, FUNCTION_ISCALLABLE); - return MORPHO_FALSE; +value builtin_imag__number(vm *v, int nargs, value *args) { + return MORPHO_FLOAT(0); } -/** Convert something to an integer */ -value builtin_int(vm *v, int nargs, value *args) { - if (nargs==1) { - value arg = MORPHO_GETARG(args, 0); - - if (MORPHO_ISSTRING(arg)) { - string_tonumber(MORPHO_GETSTRING(arg), &arg); - } - - if (MORPHO_ISFLOAT(arg)) { - return MORPHO_FLOATTOINTEGER(arg); - } else if (MORPHO_ISINTEGER(arg)) { - return arg; - } - } - morpho_runtimeerror(v, MATH_NUMARGS, FUNCTION_INT); - return MORPHO_NIL; +value builtin_imag__complex(vm *v, int nargs, value *args) { + objectcomplex *c=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); + double val; + complex_getimag(c,&val); + return MORPHO_FLOAT(val); } -/** Convert to a floating point number */ -value builtin_float(vm *v, int nargs, value *args) { - if (nargs==1) { - value arg = MORPHO_GETARG(args, 0); - - if (MORPHO_ISSTRING(arg)) { - string_tonumber(MORPHO_GETSTRING(arg), &arg); - } - - if (MORPHO_ISINTEGER(arg)) { - return MORPHO_INTEGERTOFLOAT(arg); - } else if (MORPHO_ISFLOAT(arg)){ - return arg; - } - } - morpho_runtimeerror(v, MATH_NUMARGS, FUNCTION_FLOAT); - return MORPHO_NIL; +value builtin_angle__number(vm *v, int nargs, value *args) { + double val; + morpho_valuetofloat(MORPHO_GETARG(args, 0), &val); + if (val>=0) return MORPHO_FLOAT(0); + return MORPHO_FLOAT(M_PI); } -/** Convert to a boolean */ -value builtin_bool(vm *v, int nargs, value *args) { - if (nargs==1) { - return MORPHO_BOOL(MORPHO_ISTRUE(MORPHO_GETARG(args, 0))); - } - morpho_runtimeerror(v, MATH_NUMARGS, FUNCTION_BOOL); - return MORPHO_NIL; +value builtin_angle__complex(vm *v, int nargs, value *args) { + objectcomplex *c=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); + double val; + complex_angle(c,&val); + return MORPHO_FLOAT(val); } -/** Remainder */ -value builtin_mod(vm *v, int nargs, value *args) { - value out = MORPHO_NIL; - if (nargs==2) { - value a = MORPHO_GETARG(args, 0); - value b = MORPHO_GETARG(args, 1); - - if (MORPHO_ISINTEGER(a) && MORPHO_ISINTEGER(b)) { - out=MORPHO_INTEGER(MORPHO_GETINTEGERVALUE(a) % MORPHO_GETINTEGERVALUE(b)); - } else { - if (MORPHO_ISINTEGER(a)) a=MORPHO_INTEGERTOFLOAT(a); - if (MORPHO_ISINTEGER(b)) b=MORPHO_INTEGERTOFLOAT(b); - - if (MORPHO_ISFLOAT(a) && MORPHO_ISFLOAT(b)) { - out=MORPHO_FLOAT(fmod(MORPHO_GETFLOATVALUE(a), MORPHO_GETFLOATVALUE(b))); - } else morpho_runtimeerror(v, MATH_NUMARGS, FUNCTION_INT); - } - } else morpho_runtimeerror(v, VM_INVALIDARGS, 2, nargs); +value builtin_conj__number(vm *v, int nargs, value *args) { + return MORPHO_GETARG(args, 0); +} + +value builtin_conj__complex(vm *v, int nargs, value *args) { + objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); + value out=MORPHO_NIL; + objectcomplex *new = object_newcomplex(0,0); + if (new) { + complex_conj(a, new); + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } return out; } +/* ************************************ + * Min/max + * *************************************/ + /** Find the minimum and maximum values in an enumerable object */ typedef struct { value min; @@ -481,136 +496,167 @@ static value builtin_bounds(vm *v, int nargs, value *args) { return out; } +static value builtin_bounds__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, MAX_ARGS, FUNCTION_BOUNDS); + return MORPHO_NIL; +} + /** Find the minimum value in an enumerable object */ static value builtin_min(vm *v, int nargs, value *args) { value m[nargs+1]; value out = MORPHO_NIL; if (builtin_minmaxargs(v, nargs, args, m, NULL, FUNCTION_MIN)) { - if (nargs>0) value_minmax(nargs, m, &out, NULL); - else morpho_runtimeerror(v, MAX_ARGS, FUNCTION_MIN); + value_minmax(nargs, m, &out, NULL); } return out; } +static value builtin_min__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, MAX_ARGS, FUNCTION_MIN); + return MORPHO_NIL; +} + /** Find the maximum value in an enumerable object */ static value builtin_max(vm *v, int nargs, value *args) { value m[nargs+1]; value out = MORPHO_NIL; if (builtin_minmaxargs(v, nargs, args, NULL, m, FUNCTION_MAX)) { - if (nargs>0) value_minmax(nargs, m, NULL, &out); - else morpho_runtimeerror(v, MAX_ARGS, FUNCTION_MAX); + value_minmax(nargs, m, NULL, &out); } return out; } -/** find the sign of a number */ -static value builtin_sign(vm *v, int nargs, value *args){ - if (nargs==1) { - value arg = MORPHO_GETARG(args, 0); - if (MORPHO_ISFLOAT(arg)) { - - if (MORPHO_GETFLOATVALUE(arg)>0) { - return MORPHO_FLOAT(1); - } - else if (MORPHO_GETFLOATVALUE(arg)<0){ - return MORPHO_FLOAT(-1); - } - else return MORPHO_FLOAT(0); - - } else if (MORPHO_ISINTEGER(arg)) { - if (MORPHO_GETINTEGERVALUE(arg)>0) { - return MORPHO_FLOAT(1); - } - else if (MORPHO_GETINTEGERVALUE(arg)<0){ - return MORPHO_FLOAT(-1); - } - else return MORPHO_FLOAT(0); - } else { - morpho_runtimeerror(v, MATH_ARGS,FUNCTION_SIGN); - } - } - morpho_runtimeerror(v, MATH_NUMARGS,FUNCTION_SIGN); - return MORPHO_NIL; +static value builtin_max__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, MAX_ARGS, FUNCTION_MAX); + return MORPHO_NIL; } /* ************************************ - * Apply + * Type checking and conversion * *************************************/ -/** Apply a function to a list of arguments */ -value builtin_apply(vm *v, int nargs, value *args) { - value ret = MORPHO_NIL; - - if (nargs<2) morpho_runtimeerror(v, APPLY_ARGS); - - value fn = MORPHO_GETARG(args, 0); - value x = MORPHO_GETARG(args, 1); - - if (!morpho_iscallable(fn)) { - morpho_runtimeerror(v, APPLY_NOTCALLABLE); - return MORPHO_NIL; - } - - if (nargs==2 && MORPHO_ISTUPLE(x)) { - objecttuple *t = MORPHO_GETTUPLE(x); - - morpho_call(v, fn, t->length, t->tuple, &ret); - } else if (nargs==2 && MORPHO_ISLIST(x)) { - objectlist *lst = MORPHO_GETLIST(x); - - morpho_call(v, fn, lst->val.count, lst->val.data, &ret); - } else { - morpho_call(v, fn, nargs-1, &MORPHO_GETARG(args, 1), &ret); - } +/** Typecheck functions to test for the type of a quantity */ + +#define BUILTIN_TYPECHECK(type, test) \ +value builtin_##type(vm *v, int nargs, value *args) { \ + return MORPHO_BOOL(test(MORPHO_GETARG(args, 0))); \ +} \ + \ +value builtin_numargserr_##type(vm *v, int nargs, value *args) { \ + morpho_runtimeerror(v, TYPE_NUMARGS, #type); \ + return MORPHO_FALSE; \ +} \ - return ret; -} +BUILTIN_TYPECHECK(isnil, MORPHO_ISNIL) +BUILTIN_TYPECHECK(isint, MORPHO_ISINTEGER) +BUILTIN_TYPECHECK(isfloat, MORPHO_ISFLOAT) +BUILTIN_TYPECHECK(isnumber, MORPHO_ISNUMBER) +BUILTIN_TYPECHECK(isarray, MORPHO_ISARRAY) +BUILTIN_TYPECHECK(isbool, MORPHO_ISBOOL) +BUILTIN_TYPECHECK(isclass, MORPHO_ISCLASS) +BUILTIN_TYPECHECK(isclosure, MORPHO_ISCLOSURE) +BUILTIN_TYPECHECK(iscomplex, MORPHO_ISCOMPLEX) +BUILTIN_TYPECHECK(isdictionary, MORPHO_ISDICTIONARY) +BUILTIN_TYPECHECK(isobject, MORPHO_ISOBJECT) +BUILTIN_TYPECHECK(isstring, MORPHO_ISSTRING) +BUILTIN_TYPECHECK(isrange, MORPHO_ISRANGE) +BUILTIN_TYPECHECK(islist, MORPHO_ISLIST) +BUILTIN_TYPECHECK(istuple, MORPHO_ISTUPLE) -/* ************************************ - * System - * *************************************/ +#ifdef MORPHO_INCLUDE_LINALG +BUILTIN_TYPECHECK(ismatrix, MORPHO_ISMATRIX) +#endif -/** Call the operating system */ -value builtin_system(vm *v, int nargs, value *args) { - if (nargs==1) { - value arg=MORPHO_GETARG(args, 0); - if (MORPHO_ISSTRING(arg)) { - return MORPHO_INTEGER(system(MORPHO_GETCSTRING(arg))); - } - } - return MORPHO_NIL; +#ifdef MORPHO_INCLUDE_SPARSE +BUILTIN_TYPECHECK(issparse, MORPHO_ISSPARSE) +#endif + +#ifdef MORPHO_INCLUDE_GEOMETRY +BUILTIN_TYPECHECK(ismesh, MORPHO_ISMESH) +BUILTIN_TYPECHECK(isselection, MORPHO_ISSELECTION) +BUILTIN_TYPECHECK(isfield, MORPHO_ISFIELD) +#endif + +#undef BUILTIN_TYPECHECK + +/** Check if something is callable */ +value builtin_iscallablefunction(vm *v, int nargs, value *args) { + if (MORPHO_ISCALLABLE(MORPHO_GETARG(args, 0))) return MORPHO_TRUE; + return MORPHO_FALSE; } -/** Clock */ -value builtin_clock(vm *v, int nargs, value *args) { - clock_t time; - time = clock(); - return MORPHO_FLOAT( ((double) time)/((double) CLOCKS_PER_SEC) ); +value builtin_iscallablefunction_err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, TYPE_NUMARGS, FUNCTION_ISCALLABLE); + return MORPHO_FALSE; } -#define BUILTIN_MATH(function) \ - builtin_addfunction(#function, builtin_##function, BUILTIN_FLAGSEMPTY); +/* ********************************************************************** + * Initialization + * ********************************************************************** */ + +#define BUILTIN_MATH_OLD2(function) \ + builtin_addfunction(#function, builtin_##function, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS); + +#define BUILTIN_VARMATH_RET(label, function, realret, realflags, cmplxret, cmplxflags) \ + morpho_addfunction(label, realret " (Int)", builtin_int_##function, realflags, NULL); \ + morpho_addfunction(label, realret " (Float)", builtin_float_##function, realflags, NULL); \ + morpho_addfunction(label, cmplxret " (Complex)", builtin_cmplx_##function, cmplxflags, NULL); \ + morpho_addfunction(label, "(...)", builtin_numargserr_##function, MORPHO_FN_THROWS, NULL); + +#define BUILTIN_VARMATH(label, function) \ + BUILTIN_VARMATH_RET(label, function, "Float", MORPHO_FN_PUREFN, "Complex", MORPHO_FN_ALLOCATES) #define BUILTIN_MATH_BOOL(function) \ - builtin_addfunction(#function, builtin_##function, BUILTIN_FLAGSEMPTY); + BUILTIN_VARMATH_RET(#function, function, "Bool", MORPHO_FN_PUREFN, "Bool", MORPHO_FN_PUREFN) + +#define BUILTIN_MATH(function) BUILTIN_VARMATH(#function, function) #define BUILTIN_TYPECHECK(function) \ - builtin_addfunction(#function, builtin_##function, BUILTIN_FLAGSEMPTY); + morpho_addfunction(#function, "Bool (_)", builtin_##function, MORPHO_FN_PUREFN, NULL); \ + morpho_addfunction(#function, "Bool ()", builtin_numargserr_##function, MORPHO_FN_THROWS, NULL); \ + morpho_addfunction(#function, "Bool (_,_,...)", builtin_numargserr_##function, MORPHO_FN_THROWS, NULL); void functiondefs_initialize(void) { - builtin_addfunction(FUNCTION_CLOCK, builtin_clock, BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_RANDOM, builtin_random, BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_RANDOMINT, builtin_randomint, BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_RANDOMNORMAL, builtin_randomnormal, BUILTIN_FLAGSEMPTY); - - builtin_addfunction(FUNCTION_SYSTEM, builtin_system, BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_ARCTAN, builtin_arctan, BUILTIN_FLAGSEMPTY); - - builtin_addfunction(FUNCTION_ABS, builtin_fabs, BUILTIN_FLAGSEMPTY); + // System + builtin_addfunction(FUNCTION_SYSTEM, builtin_system, MORPHO_FN_IO); + + // Clock + morpho_addfunction(FUNCTION_CLOCK, "Float ()", builtin_clock, MORPHO_FN_IO|MORPHO_FN_NONDETERMINISTIC, NULL); + + // Apply + morpho_addfunction(FUNCTION_APPLY, "(Callable,Tuple)", builtin_apply__tuple, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_APPLY, "(Callable,List)", builtin_apply__list, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_APPLY, "(Callable,_,...)", builtin_apply, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_APPLY, "()", builtin_apply__err, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_APPLY, "(_)", builtin_apply__err, MORPHO_FN_THROWS, NULL); + + // Random numbers + morpho_addfunction(FUNCTION_RANDOM, "Float ()", builtin_random, MORPHO_FN_NONDETERMINISTIC, NULL); + morpho_addfunction(FUNCTION_RANDOMINT, "Int ()", builtin_randomint_norange, MORPHO_FN_NONDETERMINISTIC, NULL); + morpho_addfunction(FUNCTION_RANDOMINT, "Int (_)", builtin_randomint, MORPHO_FN_NONDETERMINISTIC|MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_RANDOMNORMAL, "Float ()", builtin_randomnormal, MORPHO_FN_NONDETERMINISTIC, NULL); + + // Value constructors + morpho_addfunction(FUNCTION_INT, "Int (Int)", builtin_int__int, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_INT, "Int (Float)", builtin_int__float, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_INT, "Int (String)", builtin_int__string, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_INT, "Int (...)", builtin_int__err, MORPHO_FN_THROWS, NULL); + + morpho_addfunction(FUNCTION_FLOAT, "Float (Int)", builtin_float__int, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_FLOAT, "Float (Float)", builtin_float__float, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_FLOAT, "Float (String)", builtin_float__string, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_FLOAT, "Float (...)", builtin_float__err, MORPHO_FN_THROWS, NULL); + + morpho_addfunction(FUNCTION_BOOL, "Bool (_)", builtin_bool, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_BOOL, "Bool ()", builtin_bool_err, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_BOOL, "Bool (_,_,...)", builtin_bool_err, MORPHO_FN_THROWS, NULL); + + // Math functions + BUILTIN_VARMATH_RET(FUNCTION_ABS, fabs, "Float", MORPHO_FN_PUREFN, "Float", MORPHO_FN_PUREFN) BUILTIN_MATH(exp) BUILTIN_MATH(log) @@ -625,15 +671,61 @@ void functiondefs_initialize(void) { BUILTIN_MATH(sinh) BUILTIN_MATH(cosh) BUILTIN_MATH(tanh) - BUILTIN_MATH(sqrt) BUILTIN_MATH(floor) BUILTIN_MATH(ceil) + // Math properties BUILTIN_MATH_BOOL(isfinite) BUILTIN_MATH_BOOL(isinf) BUILTIN_MATH_BOOL(isnan) + // Math functions with special cases + morpho_addfunction(FUNCTION_ARCTAN, "Float (Int)", builtin_arctan__number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_ARCTAN, "Float (Float)", builtin_arctan__number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_ARCTAN, "Float (Int,Int)", builtin_arctan__number_number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_ARCTAN, "Float (Int,Float)", builtin_arctan__number_number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_ARCTAN, "Float (Float,Int)", builtin_arctan__number_number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_ARCTAN, "Float (Float,Float)", builtin_arctan__number_number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_ARCTAN, "Complex (Complex)", builtin_arctan__complex, MORPHO_FN_ALLOCATES, NULL); + morpho_addfunction(FUNCTION_ARCTAN, "Complex (Complex,Complex)", builtin_arctan__complex2, MORPHO_FN_ALLOCATES, NULL); + morpho_addfunction(FUNCTION_ARCTAN, "Complex (Complex,_)", builtin_arctan__complex2, MORPHO_FN_ALLOCATES, NULL); + morpho_addfunction(FUNCTION_ARCTAN, "Complex (_,Complex)", builtin_arctan__complex2, MORPHO_FN_ALLOCATES, NULL); + morpho_addfunction(FUNCTION_ARCTAN, "Float (...)", builtin_arctan__err, MORPHO_FN_THROWS, NULL); + BUILTIN_MATH_OLD2(sqrt); + morpho_addfunction(FUNCTION_MOD, "Int (Int,Int)", builtin_mod__int_int, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_MOD, "Float (Float,Float)", builtin_mod__float_float, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_MOD, "Float (Int,Float)", builtin_mod__int_float, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_MOD, "Float (Float,Int)", builtin_mod__float_int, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_MOD, "Float (...)", builtin_mod__err, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_SIGN, "Float (Int)", builtin_sign__int, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_SIGN, "Float (Float)", builtin_sign__float, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_SIGN, "Float (...)", builtin_sign__err, MORPHO_FN_THROWS, NULL); + + // Complex + morpho_addfunction(FUNCTION_REAL, "Float (Complex)", builtin_real__complex, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_REAL, "Int (Int)", builtin_real__number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_REAL, "Float (Float)", builtin_real__number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_IMAG, "Float (Complex)", builtin_imag__complex, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_IMAG, "Float (Int)", builtin_imag__number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_IMAG, "Float (Float)", builtin_imag__number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_ANGLE, "Float (Complex)", builtin_angle__complex, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_ANGLE, "Float (Int)", builtin_angle__number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_ANGLE, "Float (Float)", builtin_angle__number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_CONJ, "Complex (Complex)", builtin_conj__complex, MORPHO_FN_ALLOCATES, NULL); + morpho_addfunction(FUNCTION_CONJ, "Int (Int)", builtin_conj__number, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_CONJ, "Float (Float)", builtin_conj__number, MORPHO_FN_PUREFN, NULL); + + // Min/max + morpho_addfunction(FUNCTION_BOUNDS, "List (_)", builtin_bounds, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_BOUNDS, "List (_,...)", builtin_bounds, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_BOUNDS, "List ()", builtin_bounds__err, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_MIN, "(_,...)", builtin_min, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_MIN, "()", builtin_min__err, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_MAX, "(_,...)", builtin_max, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_MAX, "()", builtin_max__err, MORPHO_FN_THROWS, NULL); + + // Type checking BUILTIN_TYPECHECK(isnil) BUILTIN_TYPECHECK(isint) BUILTIN_TYPECHECK(isfloat) @@ -661,31 +753,14 @@ void functiondefs_initialize(void) { BUILTIN_TYPECHECK(isselection) BUILTIN_TYPECHECK(isfield) #endif - - builtin_addfunction(FUNCTION_REAL,builtin_real,BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_IMAG,builtin_imag,BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_ANGLE,builtin_angle,BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_CONJ,builtin_conj,BUILTIN_FLAGSEMPTY); - - builtin_addfunction(FUNCTION_ISCALLABLE, builtin_iscallablefunction, BUILTIN_FLAGSEMPTY); - - builtin_addfunction(FUNCTION_INT, builtin_int, BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_FLOAT, builtin_float, BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_BOOL, builtin_bool, BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_MOD, builtin_mod, BUILTIN_FLAGSEMPTY); - - builtin_addfunction(FUNCTION_BOUNDS, builtin_bounds, BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_MIN, builtin_min, BUILTIN_FLAGSEMPTY); - builtin_addfunction(FUNCTION_MAX, builtin_max, BUILTIN_FLAGSEMPTY); - - builtin_addfunction(FUNCTION_SIGN, builtin_sign, BUILTIN_FLAGSEMPTY); - - builtin_addfunction(FUNCTION_APPLY, builtin_apply, BUILTIN_FLAGSEMPTY); + morpho_addfunction(FUNCTION_ISCALLABLE, "Bool (_)", builtin_iscallablefunction, MORPHO_FN_PUREFN, NULL); + morpho_addfunction(FUNCTION_ISCALLABLE, "Bool ()", builtin_iscallablefunction_err, MORPHO_FN_THROWS, NULL); + morpho_addfunction(FUNCTION_ISCALLABLE, "Bool (_,_,...)", builtin_iscallablefunction_err, MORPHO_FN_THROWS, NULL); + /* Define errors */ morpho_defineerror(MATH_ARGS, ERROR_HALT, MATH_ARGS_MSG); morpho_defineerror(MATH_NUMARGS, ERROR_HALT, MATH_NUMARGS_MSG); - morpho_defineerror(MATH_ATANARGS, ERROR_HALT, MATH_ATANARGS_MSG); morpho_defineerror(TYPE_NUMARGS, ERROR_HALT, TYPE_NUMARGS_MSG); morpho_defineerror(MAX_ARGS, ERROR_HALT, MAX_ARGS_MSG); morpho_defineerror(APPLY_ARGS, ERROR_HALT, APPLY_ARGS_MSG); diff --git a/src/builtin/functiondefs.h b/src/builtin/functiondefs.h index 5ba3fd46a..097f075a8 100644 --- a/src/builtin/functiondefs.h +++ b/src/builtin/functiondefs.h @@ -13,32 +13,35 @@ * Built in function labels * ------------------------------------------------------- */ +#define FUNCTION_SYSTEM "system" +#define FUNCTION_CLOCK "clock" + +#define FUNCTION_APPLY "apply" + #define FUNCTION_RANDOM "random" #define FUNCTION_RANDOMINT "randomint" #define FUNCTION_RANDOMNORMAL "randomnormal" -#define FUNCTION_CLOCK "clock" -#define FUNCTION_SYSTEM "system" #define FUNCTION_INT "Int" #define FUNCTION_FLOAT "Float" #define FUNCTION_BOOL "Bool" + #define FUNCTION_MOD "mod" #define FUNCTION_ABS "abs" -#define FUNCTION_ISCALLABLE "iscallable" +#define FUNCTION_EXP "exp" +#define FUNCTION_SIGN "sign" +#define FUNCTION_ARCTAN "arctan" + +#define FUNCTION_REAL "real" +#define FUNCTION_IMAG "imag" +#define FUNCTION_ANGLE "angle" +#define FUNCTION_CONJ "conj" + #define FUNCTION_MIN "min" #define FUNCTION_MAX "max" #define FUNCTION_BOUNDS "bounds" -#define FUNCTION_REAL "real" -#define FUNCTION_IMAG "imag" -#define FUNCTION_ANGLE "angle" -#define FUNCTION_CONJ "conj" - -#define FUNCTION_SIGN "sign" - -#define FUNCTION_APPLY "apply" - -#define FUNCTION_ARCTAN "arctan" +#define FUNCTION_ISCALLABLE "iscallable" /* ------------------------------------------------------- * Errors thrown by builtin functions @@ -48,10 +51,7 @@ #define MATH_ARGS_MSG "Function '%s' expects numerical arguments." #define MATH_NUMARGS "ExpctArgNm" -#define MATH_NUMARGS_MSG "Function '%s' expects 1 numerical argument." - -#define MATH_ATANARGS "AtanArgNm" -#define MATH_ATANARGS_MSG "Function 'arctan' expects either 1 or 2 numerical arguments." +#define MATH_NUMARGS_MSG "Function '%s' expects a single numerical argument." #define TYPE_NUMARGS "TypArgNm" #define TYPE_NUMARGS_MSG "Function '%s' expects one argument." diff --git a/src/classes/CMakeLists.txt b/src/classes/CMakeLists.txt index ceed8d925..376453ea4 100644 --- a/src/classes/CMakeLists.txt +++ b/src/classes/CMakeLists.txt @@ -3,6 +3,7 @@ target_sources(morpho classes.h array.c array.h bool.c bool.h + cfunction.c cfunction.h closure.c closure.h clss.c clss.h cmplx.c cmplx.h @@ -17,6 +18,7 @@ target_sources(morpho json.c json.h list.c list.h metafunction.c metafunction.h + nil.c nil.h range.c range.h strng.c strng.h system.c system.h @@ -31,6 +33,8 @@ target_sources(morpho FILES classes.h array.h + bool.h + cfunction.h closure.h clss.h cmplx.h @@ -44,6 +48,7 @@ target_sources(morpho json.h list.h metafunction.h + nil.h range.h strng.h system.h diff --git a/src/classes/array.c b/src/classes/array.c index 558abe6f3..69857a00e 100644 --- a/src/classes/array.c +++ b/src/classes/array.c @@ -59,7 +59,7 @@ void object_arrayinit(objectarray *array, unsigned int ndim, unsigned int *dim) /* Store the size of the object for convenient access */ array->nelements=nel; - /* Arrays are initialized to nil. */ + /* Arrays are initialized to (float) 0.0. */ #ifdef MORPHO_NAN_BOXING memset(array->values, 0, sizeof(value)*nel); #else @@ -180,7 +180,7 @@ void array_print(vm *v, objectarray *a) { errorid array_error(objectarrayerror err) { switch (err) { case ARRAY_OUTOFBOUNDS: return VM_OUTOFBOUNDS; - case ARRAY_WRONGDIM: return VM_ARRAYWRONGDIM; + case ARRAY_WRONGDIM: return ARRAY_DIMENSION; case ARRAY_NONINTINDX: return VM_NONNUMINDX; case ARRAY_ALLOC_FAILED: return ERROR_ALLOCATIONFAILED; case ARRAY_OK: UNREACHABLE("array_error called incorrectly."); @@ -193,9 +193,9 @@ errorid array_error(objectarrayerror err) { errorid array_to_matrix_error(objectarrayerror err) { #ifdef MORPHO_INCLUDE_LINALG switch (err) { - case ARRAY_OUTOFBOUNDS: return MATRIX_INDICESOUTSIDEBOUNDS; - case ARRAY_WRONGDIM: return MATRIX_INVLDNUMINDICES; - case ARRAY_NONINTINDX: return MATRIX_INVLDINDICES; + case ARRAY_OUTOFBOUNDS: return LINALG_INDICESOUTSIDEBOUNDS; + case ARRAY_WRONGDIM: return ARRAY_DIMENSION; + case ARRAY_NONINTINDX: return ARRAY_INVLDINDICES; case ARRAY_ALLOC_FAILED: return ERROR_ALLOCATIONFAILED; case ARRAY_OK: UNREACHABLE("array_to_matrix_error called incorrectly."); } @@ -457,7 +457,7 @@ value array_constructor(vm *v, int nargs, value *args) { new = array_constructfromlist(ndim, dim, MORPHO_GETLIST(initializer)); if (!new) morpho_runtimeerror(v, ARRAY_CMPT); } else { - morpho_runtimeerror(v, ARRAY_ARGS); + morpho_runtimeerror(v, ARRAY_INIT); } // Bind the new array to the VM @@ -565,19 +565,17 @@ value Array_dimensions(vm *v, int nargs, value *args) { } /** Enumerate members of an array */ -value Array_enumerate(vm *v, int nargs, value *args) { +value Array_enumerate__int(vm *v, int nargs, value *args) { objectarray *slf = MORPHO_GETARRAY(MORPHO_SELF(args)); value out=MORPHO_NIL; - if (nargs==1 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - if (n<0) { - out=MORPHO_INTEGER(slf->nelements); - } else if (nnelements) { - out=slf->values[n]; - } else morpho_runtimeerror(v, VM_OUTOFBOUNDS); - } else MORPHO_RAISE(v, ENUMERATE_ARGS); + if (n<0) { + out=MORPHO_INTEGER(slf->nelements); + } else if (nnelements) { + out=slf->values[n]; + } else morpho_runtimeerror(v, VM_OUTOFBOUNDS); return out; } @@ -597,13 +595,13 @@ value Array_clone(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Array) -MORPHO_METHOD(MORPHO_PRINT_METHOD, Array_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_COUNT_METHOD, Array_count, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(ARRAY_DIMENSIONS_METHOD, Array_dimensions, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Array_getindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Array_setindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Array_enumerate, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Array_clone, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_PRINT_METHOD, Array_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_COUNT_METHOD, "Int ()", Array_count, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(ARRAY_DIMENSIONS_METHOD, "List ()", Array_dimensions, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Array_getindex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Array_setindex, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ENUMERATE_METHOD, " (Int)", Array_enumerate__int, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_CLONE_METHOD, "Array ()", Array_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES) MORPHO_ENDCLASS /* ********************************************************************** @@ -616,13 +614,12 @@ void array_initialize(void) { // Create array object type objectarraytype=object_addtype(&objectarraydefn); - // Locate the Object class to use as the parent class of Array - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); - // Array constructor function morpho_addfunction(ARRAY_CLASSNAME, ARRAY_CLASSNAME " (...)", array_constructor, MORPHO_FN_CONSTRUCTOR, NULL); + // Locate the Object class to use as the parent class of Array + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); + // Create Array veneer class value arrayclass=builtin_addclass(ARRAY_CLASSNAME, MORPHO_GETCLASSDEFINITION(Array), objclass); object_setveneerclass(OBJECT_ARRAY, arrayclass); @@ -631,4 +628,6 @@ void array_initialize(void) { morpho_defineerror(ARRAY_ARGS, ERROR_HALT, ARRAY_ARGS_MSG); morpho_defineerror(ARRAY_INIT, ERROR_HALT, ARRAY_INIT_MSG); morpho_defineerror(ARRAY_CMPT, ERROR_HALT, ARRAY_CMPT_MSG); + morpho_defineerror(ARRAY_DIMENSION, ERROR_HALT, ARRAY_DIMENSION_MSG); + morpho_defineerror(ARRAY_INVLDINDICES, ERROR_HALT, ARRAY_INVLDINDICES_MSG); } diff --git a/src/classes/array.h b/src/classes/array.h index e0b7f97ba..2f5fa9507 100644 --- a/src/classes/array.h +++ b/src/classes/array.h @@ -65,6 +65,12 @@ objectarray *object_arrayfromvalueindices(unsigned int ndim, value *dim); #define ARRAY_CMPT "ArrayCmpt" #define ARRAY_CMPT_MSG "Array initializer is not compatible with the requested dimensions." +#define ARRAY_DIMENSION "ArrayDim" +#define ARRAY_DIMENSION_MSG "Incorrect number of dimensions for Array." + +#define ARRAY_INVLDINDICES "ArrayIndx" +#define ARRAY_INVLDINDICES_MSG "Array requires integers as indices." + /* ------------------------------------------------------- * Array interface * ------------------------------------------------------- */ diff --git a/src/classes/bool.c b/src/classes/bool.c index 95d2ee37c..7968d6aea 100644 --- a/src/classes/bool.c +++ b/src/classes/bool.c @@ -12,10 +12,10 @@ * ********************************************************************** */ MORPHO_BEGINCLASS(Bool) -MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_RESPONDSTO_METHOD, Object_respondsto, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_INVOKE_METHOD, Object_invoke, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_RESPONDSTO_METHOD, Object_respondsto, MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_INVOKE_METHOD, Object_invoke, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO) MORPHO_ENDCLASS /* ********************************************************************** diff --git a/src/classes/cfunction.c b/src/classes/cfunction.c new file mode 100644 index 000000000..6ae775174 --- /dev/null +++ b/src/classes/cfunction.c @@ -0,0 +1,53 @@ +/** @file cfunction.c + * @author T J Atherton + * + * @brief Veneer class for C functions + */ + +#include "morpho.h" +#include "classes.h" +#include "common.h" + +/* ********************************************************************** + * CFunction veneer class + * ********************************************************************** */ + +value CFunction_tostring(vm *v, int nargs, value *args) { + objectbuiltinfunction *func=MORPHO_GETBUILTINFUNCTION(MORPHO_SELF(args)); + value out = MORPHO_NIL; + + varray_char buffer; + varray_charinit(&buffer); + + varray_charadd(&buffer, "name, &buffer); + varray_charwrite(&buffer, '>'); + + out = object_stringfromvarraychar(&buffer); + if (MORPHO_ISSTRING(out)) { + morpho_bindobjects(v, 1, &out); + } + varray_charclear(&buffer); + + return out; +} + +MORPHO_BEGINCLASS(CFunction) +MORPHO_METHOD(MORPHO_TOSTRING_METHOD, CFunction_tostring, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO) +MORPHO_ENDCLASS + +/* ********************************************************************** + * Initialization and finalization + * ********************************************************************** */ + +void cfunction_initialize(void) { + // Locate the Callable class to use as the parent class of CFunction + value objclass = builtin_findclassfromcstring(CALLABLE_CLASSNAME); + + // No constructor function; cfunctions are defined in C. + + // Create CFunction veneer class + value cfunctionclass=builtin_addclass(CFUNCTION_CLASSNAME, MORPHO_GETCLASSDEFINITION(CFunction), objclass); + object_setveneerclass(OBJECT_BUILTINFUNCTION, cfunctionclass); +} diff --git a/src/classes/cfunction.h b/src/classes/cfunction.h new file mode 100644 index 000000000..04fb51f93 --- /dev/null +++ b/src/classes/cfunction.h @@ -0,0 +1,26 @@ +/** @file cfunction.h + * @author T J Atherton + * + * @brief Veneer class for C functions + */ + +#ifndef cfunction_h +#define cfunction_h + +/* ------------------------------------------------------- + * CFunction veneer class + * ------------------------------------------------------- */ + +#define CFUNCTION_CLASSNAME "CFunction" + +/* ------------------------------------------------------- + * CFunction error messages + * ------------------------------------------------------- */ + +/* ------------------------------------------------------- + * CFunction interface + * ------------------------------------------------------- */ + +void cfunction_initialize(void); + +#endif diff --git a/src/classes/classes.h b/src/classes/classes.h index 4422bf2cc..75d48dec3 100644 --- a/src/classes/classes.h +++ b/src/classes/classes.h @@ -13,6 +13,7 @@ #include "function.h" #include "metafunction.h" #include "clss.h" +#include "cfunction.h" #include "cmplx.h" #include "closure.h" #include "invocation.h" @@ -28,11 +29,12 @@ #include "bool.h" #include "flt.h" #include "int.h" +#include "nil.h" //#include "file.h" //#include "system.h" #include "json.h" -#include "matrix.h" +#include "linalg.h" #endif /* classes_h */ diff --git a/src/classes/closure.c b/src/classes/closure.c index e6dc10a66..83e6d6add 100644 --- a/src/classes/closure.c +++ b/src/classes/closure.c @@ -103,8 +103,8 @@ value Closure_tostring(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Closure) -MORPHO_METHOD(MORPHO_TOSTRING_METHOD, Closure_tostring, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_TOSTRING_METHOD, Closure_tostring, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO) MORPHO_ENDCLASS /* ********************************************************************** @@ -117,9 +117,8 @@ void closure_initialize(void) { // Create closure object type objectclosuretype=object_addtype(&objectclosuredefn); - // Locate the Object class to use as the parent class of Closure - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + // Locate the Callable class to use as the parent class of Closure + value objclass = builtin_findclassfromcstring(CALLABLE_CLASSNAME); // No constructor function; closures are generated by the runtime diff --git a/src/classes/clss.c b/src/classes/clss.c index b08944967..f590ff34d 100644 --- a/src/classes/clss.c +++ b/src/classes/clss.c @@ -46,6 +46,8 @@ objecttypedefn objectclassdefn = { .cmpfn=NULL }; +static int objectclassuid = 0; + objectclass *object_newclass(value name) { objectclass *newclass = (objectclass *) object_new(sizeof(objectclass), OBJECT_CLASS); @@ -56,7 +58,7 @@ objectclass *object_newclass(value name) { varray_valueinit(&newclass->children); varray_valueinit(&newclass->linearization); newclass->superclass=NULL; - newclass->uid=0; + newclass->uid=objectclassuid++; } return newclass; @@ -167,15 +169,42 @@ bool class_linearize(objectclass *klass) { return _linearize(klass, &klass->linearization); } +/** Finds the position of a class within another class's linearization. */ +static bool _findinlinearization(objectclass *klass, objectclass *target, int *out) { + for (int i=0; ilinearization.count; i++) { + if (MORPHO_GETCLASS(klass->linearization.data[i])==target) { *out=i; return true; } + } + + return false; +} + +/** @brief Compare the distance between two classes. + * @param[in] a - + * @param[in] b - Classes to compare. + * @param[out] out - signed distance between the two classes; Negative means a is more specific; positive means b is + * more specific. + * @returns true if one class appears in the other's linearization. */ +bool class_comparedistance(objectclass *a, objectclass *b, int *out) { + if (!a || !b || !out) return false; + if (a==b) { + *out=0; return true; + } else if (_findinlinearization(a, b, out)) { + *out *= -1; return true; + } else if (_findinlinearization(b, a, out)) { + return true; + } + return false; +} + /* ********************************************************************** * Class veneer class * ********************************************************************** */ MORPHO_BEGINCLASS(Class) -MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_RESPONDSTO_METHOD, Object_respondsto, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_INVOKE_METHOD, Object_invoke, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_RESPONDSTO_METHOD, Object_respondsto, MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_INVOKE_METHOD, Object_invoke, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO) MORPHO_ENDCLASS /* ********************************************************************** @@ -187,15 +216,13 @@ objecttype objectclasstype; void class_initialize(void) { // objectclass is a core type so is intialized earlier - // Locate the Object class to use as the parent class of Class - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + // Locate the Callable class to use as the parent class of Class + value callableclass = builtin_findclassfromcstring(CALLABLE_CLASSNAME); - value classclass=builtin_addclass(CLASS_CLASSNAME, MORPHO_GETCLASSDEFINITION(Class), objclass); + value classclass=builtin_addclass(CLASS_CLASSNAME, MORPHO_GETCLASSDEFINITION(Class), callableclass); object_setveneerclass(OBJECT_CLASS, classclass); - // No constructor function; classes are generated by the compiler + // No constructor function; classes are created internally // Class error messages - morpho_defineerror(CLASS_INVK, ERROR_HALT, CLASS_INVK_MSG); } diff --git a/src/classes/clss.h b/src/classes/clss.h index 6b7b1a267..df943c84e 100644 --- a/src/classes/clss.h +++ b/src/classes/clss.h @@ -46,9 +46,6 @@ typedef struct sobjectclass { * Class error messages * ------------------------------------------------------- */ -#define CLASS_INVK "ClssInvk" -#define CLASS_INVK_MSG "Cannot invoke method '%s' on a class." - /* ------------------------------------------------------- * Class interface * ------------------------------------------------------- */ @@ -57,6 +54,7 @@ objectclass *object_newclass(value name); objectclass *morpho_lookupclass(value obj); bool class_linearize(objectclass *klass); +bool class_comparedistance(objectclass *a, objectclass *b, int *out); void class_initialize(void); diff --git a/src/classes/cmplx.c b/src/classes/cmplx.c index 3009e2a9b..ab7974dc6 100644 --- a/src/classes/cmplx.c +++ b/src/classes/cmplx.c @@ -268,7 +268,7 @@ value complex_builtinceil(vm * v, objectcomplex *c) { #undef RET_DOUBLE #define COMPLEX_BUILTIN_BOOL(fcn,logicalop)\ -value complex_builtin##fcn(objectcomplex *c) {\ +value complex_builtin##fcn(vm *v, objectcomplex *c) {\ bool val = fcn(creal(c->Z)) logicalop fcn(cimag(c->Z));\ return MORPHO_BOOL(val);\ } @@ -362,33 +362,17 @@ value complex_constructor(vm *v, int nargs, value *args) { /** Gets the real part of a complex number */ value Complex_getreal(vm *v, int nargs, value *args) { objectcomplex *c=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); - - value out = MORPHO_NIL; - if (nargs>0){ - morpho_runtimeerror(v, COMPLEX_INVLDNARG); - return out; - } - double real; complex_getreal(c, &real); - out = MORPHO_FLOAT(real); - return out; + return MORPHO_FLOAT(real); } /** Gets the imaginary part of a complex number */ value Complex_getimag(vm *v, int nargs, value *args) { objectcomplex *c=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); - - value out = MORPHO_NIL; - if (nargs>0){ - morpho_runtimeerror(v, COMPLEX_INVLDNARG); - return out; - } - double imag; complex_getimag(c, &imag); - out = MORPHO_FLOAT(imag); - return out; + return MORPHO_FLOAT(imag); } /** Prints a complex */ @@ -402,19 +386,21 @@ value Complex_print(vm *v, int nargs, value *args) { } /** Complex add */ -value Complex_add(vm *v, int nargs, value *args) { +value Complex_add__complex(vm *v, int nargs, value *args) { + objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); + objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); + + objectcomplex *new = object_newcomplex(0, 0); + if (new) complex_add(a, b, new); + + return morpho_wrapandbind(v, (object *) new); +} + +value Complex_add__x(vm *v, int nargs, value *args) { objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); value out=MORPHO_NIL; - if (nargs==1 && MORPHO_ISCOMPLEX(MORPHO_GETARG(args, 0))) { - objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); - - objectcomplex *new = object_newcomplex(0, 0); - if (new) { - out=MORPHO_OBJECT(new); - complex_add(a, b, new); - } - } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + if (MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { double val; if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { objectcomplex *new = object_newcomplex(0,0); @@ -423,7 +409,7 @@ value Complex_add(vm *v, int nargs, value *args) { complex_add_real(a, val, new); } } - } else morpho_runtimeerror(v, COMPLEX_ARITHARGS); + } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); @@ -431,19 +417,21 @@ value Complex_add(vm *v, int nargs, value *args) { } /** Complex subtract */ -value Complex_sub(vm *v, int nargs, value *args) { +value Complex_sub__complex(vm *v, int nargs, value *args) { + objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); + objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); + + objectcomplex *new = object_newcomplex(0, 0); + if (new) complex_sub(a, b, new); + + return morpho_wrapandbind(v, (object *) new); +} + +value Complex_sub__x(vm *v, int nargs, value *args) { objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); value out=MORPHO_NIL; - if (nargs==1 && MORPHO_ISCOMPLEX(MORPHO_GETARG(args, 0))) { - objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); - - objectcomplex *new = object_newcomplex(0, 0); - if (new) { - out=MORPHO_OBJECT(new); - complex_sub(a, b, new); - } - } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + if (MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { double val; if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { objectcomplex *new = object_newcomplex(0,0); @@ -452,7 +440,7 @@ value Complex_sub(vm *v, int nargs, value *args) { complex_add_real(a, -val, new); } } - } else morpho_runtimeerror(v, COMPLEX_ARITHARGS); + } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); @@ -460,11 +448,11 @@ value Complex_sub(vm *v, int nargs, value *args) { } /** Right subtract */ -value Complex_subr(vm *v, int nargs, value *args) { +value Complex_subr__x(vm *v, int nargs, value *args) { objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); value out=MORPHO_NIL; - if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + if (MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { double val; if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { objectcomplex *new = object_clonecomplex(a); @@ -475,7 +463,7 @@ value Complex_subr(vm *v, int nargs, value *args) { complex_add_real(new, val, new); } } - } else morpho_runtimeerror(v, COMPLEX_ARITHARGS); + } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); @@ -483,19 +471,21 @@ value Complex_subr(vm *v, int nargs, value *args) { } /** Complex multiply */ -value Complex_mul(vm *v, int nargs, value *args) { +value Complex_mul__complex(vm *v, int nargs, value *args) { + objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); + objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); + + objectcomplex *new = object_newcomplex(0, 0); + if (new) complex_mul(a, b, new); + + return morpho_wrapandbind(v, (object *) new); +} + +value Complex_mul__x(vm *v, int nargs, value *args) { objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); value out=MORPHO_NIL; - if (nargs==1 && MORPHO_ISCOMPLEX(MORPHO_GETARG(args, 0))) { - objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); - - objectcomplex *new = object_newcomplex(0, 0); - if (new) { - out=MORPHO_OBJECT(new); - complex_mul(a, b, new); - } - } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + if (MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { double val; if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { objectcomplex *new = object_newcomplex(0,0); @@ -504,7 +494,7 @@ value Complex_mul(vm *v, int nargs, value *args) { complex_mul_real(a, val, new); } } - } else morpho_runtimeerror(v, COMPLEX_ARITHARGS); + } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); @@ -512,19 +502,21 @@ value Complex_mul(vm *v, int nargs, value *args) { } /** Complex divide */ -value Complex_div(vm *v, int nargs, value *args) { +value Complex_div__complex(vm *v, int nargs, value *args) { + objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); + objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); + + objectcomplex *new = object_newcomplex(0, 0); + if (new) complex_div(a, b, new); + + return morpho_wrapandbind(v, (object *) new); +} + +value Complex_div__x(vm *v, int nargs, value *args) { objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); value out=MORPHO_NIL; - if (nargs==1 && MORPHO_ISCOMPLEX(MORPHO_GETARG(args, 0))) { - objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); - - objectcomplex *new = object_newcomplex(0, 0); - if (new) { - out=MORPHO_OBJECT(new); - complex_div(a, b, new); - } - } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + if (MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { double val; if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { objectcomplex *new = object_newcomplex(0,0); @@ -533,7 +525,7 @@ value Complex_div(vm *v, int nargs, value *args) { complex_mul_real(a, 1.0/val, new); } } - } else morpho_runtimeerror(v, COMPLEX_ARITHARGS); + } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); @@ -541,12 +533,11 @@ value Complex_div(vm *v, int nargs, value *args) { } /** Complex right divide */ -value Complex_divr(vm *v, int nargs, value *args) { - // this gets called when we divide a nonobject (number) by a complex number +value Complex_divr__x(vm *v, int nargs, value *args) { objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); value out=MORPHO_NIL; - if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + if (MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { double val; if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { @@ -559,27 +550,27 @@ value Complex_divr(vm *v, int nargs, value *args) { morpho_bindobjects(v, 1, &out); } } else UNREACHABLE("Number did not return float value"); - } else morpho_runtimeerror(v, COMPLEX_ARITHARGS); + } return out; } /** Complex exponentiation */ -value Complex_power(vm *v, int nargs, value *args) { +value Complex_power__complex(vm *v, int nargs, value *args) { + objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); + objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); + + objectcomplex *new = object_newcomplex(0, 0); + if (new) complex_cpower(a, b, new); + + return morpho_wrapandbind(v, (object *) new); +} + +value Complex_power__x(vm *v, int nargs, value *args) { objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); value out=MORPHO_NIL; - if (nargs==1 && MORPHO_ISCOMPLEX(MORPHO_GETARG(args, 0))) { - // raise a complex number to a complex power - objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); - - objectcomplex *new = object_newcomplex(0, 0); - if (new) { - out=MORPHO_OBJECT(new); - complex_cpower(a, b, new); - } - } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { - // raise complex power to a number + if (MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { double val; if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { objectcomplex *new = object_newcomplex(0,0); @@ -588,7 +579,7 @@ value Complex_power(vm *v, int nargs, value *args) { complex_power(a, val, new); } } - } else morpho_runtimeerror(v, COMPLEX_ARITHARGS); + } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); @@ -596,21 +587,21 @@ value Complex_power(vm *v, int nargs, value *args) { } /** Complex right exponentiation */ -value Complex_powerr(vm *v, int nargs, value *args) { +value Complex_powerr__complex(vm *v, int nargs, value *args) { + objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); + objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); + + objectcomplex *new = object_newcomplex(0, 0); + if (new) complex_cpower(a, b, new); + + return morpho_wrapandbind(v, (object *) new); +} + +value Complex_powerr__x(vm *v, int nargs, value *args) { objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); value out=MORPHO_NIL; - if (nargs==1 && MORPHO_ISCOMPLEX(MORPHO_GETARG(args, 0))) { - // raise a complex number to a complex power - objectcomplex *b=MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0)); - - objectcomplex *new = object_newcomplex(0, 0); - if (new) { - out=MORPHO_OBJECT(new); - complex_cpower(a, b, new); - } - } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { - // raise a number to a complex power + if (MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { double val; if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { objectcomplex *new = object_newcomplex(val,0); @@ -619,12 +610,11 @@ value Complex_powerr(vm *v, int nargs, value *args) { complex_cpower(new, a, new); } } - } else morpho_runtimeerror(v, COMPLEX_ARITHARGS); + } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); return out; - } /** Angle of a complex number */ @@ -634,6 +624,8 @@ value Complex_angle(vm *v, int nargs, value *args) { complex_angle(a, &val); return MORPHO_FLOAT(val); } + +/** Absolute value of a complex number */ value Complex_abs(vm *v, int nargs, value *args) { objectcomplex *a=MORPHO_GETCOMPLEX(MORPHO_SELF(args)); double val; @@ -669,23 +661,31 @@ value Complex_clone(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(ComplexNum) -MORPHO_METHOD(MORPHO_PRINT_METHOD, Complex_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ADD_METHOD, Complex_add, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SUB_METHOD, Complex_sub, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_MUL_METHOD, Complex_mul, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_DIV_METHOD, Complex_div, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ADDR_METHOD, Complex_add, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SUBR_METHOD, Complex_subr, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_MULR_METHOD, Complex_mul, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_DIVR_METHOD, Complex_divr, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_POW_METHOD, Complex_power, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_POWR_METHOD, Complex_powerr, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(COMPLEX_ANGLE_METHOD, Complex_angle, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(COMPLEX_CONJUGATE_METHOD, Complex_conjugate, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(COMPLEX_REAL_METHOD, Complex_getreal, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(COMPLEX_IMAG_METHOD, Complex_getimag, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(COMPLEX_ABS_METHOD, Complex_abs, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Complex_clone, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_PRINT_METHOD, Complex_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "Complex (Complex)", Complex_add__complex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "Complex (_)", Complex_add__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "Complex (Complex)", Complex_sub__complex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "Complex (_)", Complex_sub__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_MUL_METHOD, "Complex (Complex)", Complex_mul__complex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_MUL_METHOD, "Complex (_)", Complex_mul__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_DIV_METHOD, "Complex (Complex)", Complex_div__complex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_DIV_METHOD, "Complex (_)", Complex_div__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ADDR_METHOD, "Complex (Complex)", Complex_add__complex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ADDR_METHOD, "Complex (_)", Complex_add__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_SUBR_METHOD, "Complex (_)", Complex_subr__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_MULR_METHOD, "Complex (Complex)", Complex_mul__complex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_MULR_METHOD, "Complex (_)", Complex_mul__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_DIVR_METHOD, "Complex (_)", Complex_divr__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_POW_METHOD, "Complex (Complex)", Complex_power__complex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_POW_METHOD, "Complex (_)", Complex_power__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_POWR_METHOD, "Complex (Complex)", Complex_powerr__complex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_POWR_METHOD, "Complex (_)", Complex_powerr__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(COMPLEX_ANGLE_METHOD, "Float ()", Complex_angle, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(COMPLEX_CONJUGATE_METHOD, "Complex ()", Complex_conjugate, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(COMPLEX_REAL_METHOD, "Float ()", Complex_getreal, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(COMPLEX_IMAG_METHOD, "Float ()", Complex_getimag, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(COMPLEX_ABS_METHOD, "Float ()", Complex_abs, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_CLONE_METHOD, "Complex ()", Complex_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES) MORPHO_ENDCLASS /* ********************************************************************** @@ -697,10 +697,9 @@ void complex_initialize(void) { objectcomplextype=object_addtype(&objectcomplexdefn); // Complex constructor function - morpho_addfunction(COMPLEX_CLASSNAME, COMPLEX_CLASSNAME " (...)", complex_constructor, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(COMPLEX_CLASSNAME, COMPLEX_CLASSNAME " (_,_)", complex_constructor, MORPHO_FN_CONSTRUCTOR, NULL); - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); // Define Complex class value complexclass=builtin_addclass(COMPLEX_CLASSNAME, MORPHO_GETCLASSDEFINITION(ComplexNum), objclass); diff --git a/src/classes/cmplx.h b/src/classes/cmplx.h index 377b57210..767e8521f 100644 --- a/src/classes/cmplx.h +++ b/src/classes/cmplx.h @@ -117,9 +117,9 @@ value complex_builtinsqrt(vm *v, objectcomplex *c); value complex_builtinfloor(vm *v, objectcomplex *c); value complex_builtinceil(vm *v, objectcomplex *c); -value complex_builtinisfinite(objectcomplex *c); -value complex_builtinisinf(objectcomplex *c); -value complex_builtinisnan(objectcomplex *c); +value complex_builtinisfinite(vm *v, objectcomplex *c); +value complex_builtinisinf(vm *v, objectcomplex *c); +value complex_builtinisnan(vm *v, objectcomplex *c); value complex_builtinatan(vm *v, value c); value complex_builtinatan2(vm *v, value c1, value c2); diff --git a/src/classes/dict.c b/src/classes/dict.c index 3f56ccb8c..37592aebf 100644 --- a/src/classes/dict.c +++ b/src/classes/dict.c @@ -125,9 +125,7 @@ value Dictionary_contains(vm *v, int nargs, value *args) { objectdictionary *slf = MORPHO_GETDICTIONARY(MORPHO_SELF(args)); value out=MORPHO_FALSE; - if (nargs==1) { - if (dictionary_get(&slf->dict, MORPHO_GETARG(args, 0), &out)) out=MORPHO_TRUE; - } + if (dictionary_get(&slf->dict, MORPHO_GETARG(args, 0), &out)) out=MORPHO_TRUE; return out; } @@ -186,13 +184,10 @@ value Dictionary_count(vm *v, int nargs, value *args) { value Dictionary_enumerate(vm *v, int nargs, value *args) { objectdictionary *slf = MORPHO_GETDICTIONARY(MORPHO_SELF(args)); value out=MORPHO_NIL; + int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - if (nargs==1 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - - if (n<0) out=MORPHO_INTEGER(slf->dict.count); - else out=dictionary_iterate(slf, n); - } else MORPHO_RAISE(v, ENUMERATE_ARGS); + if (n<0) out=MORPHO_INTEGER(slf->dict.count); + else out=dictionary_iterate(slf, n); return out; } @@ -233,17 +228,14 @@ value Dictionary_clone(vm *v, int nargs, value *args) { value Dictionary_##op(vm *v, int nargs, value *args) { \ objectdictionary *slf = MORPHO_GETDICTIONARY(MORPHO_SELF(args)); \ value out=MORPHO_NIL; \ + objectdictionary *new = object_newdictionary(); \ + objectdictionary *b = MORPHO_GETDICTIONARY(MORPHO_GETARG(args, 0)); \ \ - if (nargs>0 && MORPHO_ISDICTIONARY(MORPHO_GETARG(args, 0))) { \ - objectdictionary *new = object_newdictionary(); \ - \ - if (new) { \ - objectdictionary *b =MORPHO_GETDICTIONARY(MORPHO_GETARG(args, 0)); \ - dictionary_##op(&slf->dict, &b->dict, &new->dict); \ - out=MORPHO_OBJECT(new); \ - morpho_bindobjects(v, 1, &out); \ - } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); \ - } else morpho_runtimeerror(v, DICT_DCTSTARG); \ + if (new) { \ + dictionary_##op(&slf->dict, &b->dict, &new->dict); \ + out=MORPHO_OBJECT(new); \ + morpho_bindobjects(v, 1, &out); \ + } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); \ \ return out; \ } @@ -252,22 +244,37 @@ DICTIONARY_SETOP(union) DICTIONARY_SETOP(intersection) DICTIONARY_SETOP(difference) +#define DICTIONARY_SETOP_ERR(op) \ +value Dictionary_##op##__err(vm *v, int nargs, value *args) { \ + morpho_runtimeerror(v, DICT_DCTSTARG); \ + return MORPHO_NIL; \ +} + +DICTIONARY_SETOP_ERR(union) +DICTIONARY_SETOP_ERR(intersection) +DICTIONARY_SETOP_ERR(difference) + MORPHO_BEGINCLASS(Dictionary) -MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Dictionary_getindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Dictionary_setindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CONTAINS_METHOD, Dictionary_contains, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(DICTIONARY_REMOVE_METHOD, Dictionary_remove, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(DICTIONARY_CLEAR_METHOD, Dictionary_clear, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Dictionary_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_COUNT_METHOD, Dictionary_count, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Dictionary_enumerate, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(DICTIONARY_KEYS_METHOD, Dictionary_keys, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Dictionary_clone, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_UNION_METHOD, Dictionary_union, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_INTERSECTION_METHOD, Dictionary_intersection, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_DIFFERENCE_METHOD, Dictionary_difference, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ADD_METHOD, Dictionary_union, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SUB_METHOD, Dictionary_difference, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Dictionary_getindex, MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Dictionary_setindex, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MORPHO_CONTAINS_METHOD, "Bool (_)", Dictionary_contains, MORPHO_FN_PUREFN), +MORPHO_METHOD(DICTIONARY_REMOVE_METHOD, Dictionary_remove, MORPHO_FN_MUTATES), +MORPHO_METHOD(DICTIONARY_CLEAR_METHOD, Dictionary_clear, MORPHO_FN_MUTATES), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Dictionary_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_COUNT_METHOD, "Int ()", Dictionary_count, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_ENUMERATE_METHOD, " (Int)", Dictionary_enumerate, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(DICTIONARY_KEYS_METHOD, "List ()", Dictionary_keys, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_CLONE_METHOD, "Dictionary ()", Dictionary_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_UNION_METHOD, "Dictionary (Dictionary)", Dictionary_union, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_UNION_METHOD, "Nil (...)", Dictionary_union__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_INTERSECTION_METHOD, "Dictionary (Dictionary)", Dictionary_intersection, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_INTERSECTION_METHOD, "Nil (...)", Dictionary_intersection__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_DIFFERENCE_METHOD, "Dictionary (Dictionary)", Dictionary_difference, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_DIFFERENCE_METHOD, "Nil (...)", Dictionary_difference__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "Dictionary (Dictionary)", Dictionary_union, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "Nil (...)", Dictionary_union__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "Dictionary (Dictionary)", Dictionary_difference, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "Nil (...)", Dictionary_difference__err, MORPHO_FN_THROWS) MORPHO_ENDCLASS @@ -282,8 +289,7 @@ void dict_initialize(void) { objectdictionarytype=object_addtype(&objectdictionarydefn); // Locate the Object class to use as the parent class of Dictionary - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); // Dictionary constructor function morpho_addfunction(DICTIONARY_CLASSNAME, DICTIONARY_CLASSNAME " (...)", dictionary_constructor, MORPHO_FN_CONSTRUCTOR, NULL); diff --git a/src/classes/err.c b/src/classes/err.c index cfaf7fe89..85ae9e809 100644 --- a/src/classes/err.c +++ b/src/classes/err.c @@ -92,10 +92,10 @@ value Error_print(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Error) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Error_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_THROW_METHOD, Error_throw, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_WARNING_METHOD, Error_warning, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Error_print, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Error_init, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_THROW_METHOD, Error_throw, MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_WARNING_METHOD, Error_warning, MORPHO_FN_IO), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Error_print, MORPHO_FN_IO) MORPHO_ENDCLASS /* ********************************************************************** @@ -104,8 +104,7 @@ MORPHO_ENDCLASS void err_initialize(void) { // Locate the Object class to use as the parent class of Error - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); // Create Error class builtin_addclass(ERROR_CLASSNAME, MORPHO_GETCLASSDEFINITION(Error), objclass); diff --git a/src/classes/file.c b/src/classes/file.c index b6f588c58..0eee02661 100644 --- a/src/classes/file.c +++ b/src/classes/file.c @@ -110,6 +110,19 @@ void file_setworkingdirectory(const char *path) { } } +/** Gets the global current working directory (relative to the filing systems cwd. + * @param[out] path - path to working directory. */ +void file_getworkingdirectory(varray_char *path) +{ + if (workingdir.count>0) { + for (unsigned int i=0; idata, sizeof(char), size, f); string->data[nread]='\0'; + string->count=(unsigned int) nread+1; } return true; @@ -185,34 +199,12 @@ value file_readlineusingvarray(FILE *f, varray_char *string) { * File class * ********************************************************************** */ -/** File constructor - * In: 1. a file name - * 2. (optional) a string giving the requested status, e.g. "wr+" - */ -value file_constructor(vm *v, int nargs, value *args) { +/** Open a file using an already-validated name and mode string. */ +static value file_open(vm *v, value filenamearg, char *cmode) { objectfile *new=NULL; value out=MORPHO_NIL; value filename=MORPHO_NIL; - char *fname=NULL; - char *cmode = "r"; - - if (nargs>0) { - if (MORPHO_ISSTRING(MORPHO_GETARG(args, 0))) { - fname=MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)); - } else MORPHO_RAISE(v, FILE_FILENAMEARG); - - if (nargs>1) { - if (MORPHO_ISSTRING(MORPHO_GETARG(args, 1))) { - char *mode=MORPHO_GETCSTRING(MORPHO_GETARG(args, 1)); - switch (mode[0]) { - case 'r': cmode="r"; break; - case 'w': cmode="w"; break; - case 'a': cmode="a"; break; - default: MORPHO_RAISE(v, FILE_MODE); - } - } else MORPHO_RAISE(v, FILE_MODE); - } - } else MORPHO_RAISE(v, FILE_NEEDSFILENAME); + char *fname=MORPHO_GETCSTRING(filenamearg); if (fname) { FILE *f = file_openrelative(fname, cmode); @@ -231,6 +223,45 @@ value file_constructor(vm *v, int nargs, value *args) { return out; } +/** File constructor: File(String) */ +value file_constructor__string(vm *v, int nargs, value *args) { + return file_open(v, MORPHO_GETARG(args, 0), "r"); +} + +/** File constructor: File(String,String) */ +value file_constructor__string_string(vm *v, int nargs, value *args) { + char *cmode = "r"; + char *mode=MORPHO_GETCSTRING(MORPHO_GETARG(args, 1)); + + switch (mode[0]) { + case 'r': cmode="r"; break; + case 'w': cmode="w"; break; + case 'a': cmode="a"; break; + default: MORPHO_RAISE(v, FILE_MODE); + } + + return file_open(v, MORPHO_GETARG(args, 0), cmode); +} + +/** File constructor missing filename error */ +value file_constructor__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, FILE_NEEDSFILENAME); + return MORPHO_NIL; +} + +/** File constructor bad filename argument */ +value file_constructor__filenamearg(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, FILE_FILENAMEARG); + return MORPHO_NIL; +} + +/** File constructor bad two-argument call */ +value file_constructor__args(vm *v, int nargs, value *args) { + if (!MORPHO_ISSTRING(MORPHO_GETARG(args, 0))) morpho_runtimeerror(v, FILE_FILENAMEARG); + else morpho_runtimeerror(v, FILE_MODE); + return MORPHO_NIL; +} + /** Close a file */ value File_close(vm *v, int nargs, value *args) { FILE *f=file_getfile(MORPHO_SELF(args)); @@ -367,15 +398,15 @@ value File_eof(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(File) -MORPHO_METHOD(FILE_CLOSE, File_close, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FILE_LINES, File_lines, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FILE_READALL, File_readall, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FILE_READLINE, File_readline, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FILE_READCHAR, File_readchar, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FILE_WRITE, File_write, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FILE_RELATIVEPATH, File_relativepath, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FILE_FILENAME, File_filename, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FILE_EOF, File_eof, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(FILE_CLOSE, File_close, MORPHO_FN_IO|MORPHO_FN_MUTATES), +MORPHO_METHOD(FILE_LINES, File_lines, MORPHO_FN_IO|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(FILE_READALL, File_readall, MORPHO_FN_IO|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(FILE_READLINE, File_readline, MORPHO_FN_IO|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(FILE_READCHAR, File_readchar, MORPHO_FN_IO|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(FILE_WRITE, File_write, MORPHO_FN_IO|MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FILE_RELATIVEPATH, File_relativepath, MORPHO_FN_IO|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(FILE_FILENAME, File_filename, MORPHO_FN_NONE), +MORPHO_METHOD(FILE_EOF, File_eof, MORPHO_FN_IO) MORPHO_ENDCLASS /* ********************************************************************** @@ -383,63 +414,90 @@ MORPHO_ENDCLASS * ********************************************************************** */ /** Detect whether a resource is a folder */ -value Folder_isfolder(vm *v, int nargs, value *args) { +value Folder_isfolder__string(vm *v, int nargs, value *args) { value ret = MORPHO_FALSE; - if (nargs==1 && MORPHO_ISSTRING(MORPHO_GETARG(args, 0))) { - varray_char name; - varray_charinit(&name); - file_relativepath(MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)), &name); - - if (platform_isdirectory(name.data)) ret=MORPHO_TRUE; - - varray_charclear(&name); - } else morpho_runtimeerror(v, FOLDER_EXPCTPATH); + varray_char name; + varray_charinit(&name); + file_relativepath(MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)), &name); + + if (platform_isdirectory(name.data)) ret=MORPHO_TRUE; + + varray_charclear(&name); return ret; } +/** Normalizes a given path, replacing folder separators with the correct ones for the platform */ +value Folder_normalizepath(vm *v, int nargs, value *args) { + size_t n = platform_maxpathsize(); + char buffer[n]; + if (!platform_normalizepath(MORPHO_GETCSTRING(MORPHO_GETARG(args,0)), n, buffer)) return MORPHO_NIL; + + value out=object_stringfromcstring(buffer, strlen(buffer)); + if (MORPHO_ISSTRING(out)) morpho_bindobjects(v, 1, &out); + else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + return out; +} + /** Return the contents of a folder */ value Folder_contents(vm *v, int nargs, value *args) { value ret = MORPHO_NIL; - if (nargs==1 && MORPHO_ISSTRING(MORPHO_GETARG(args, 0))) { - varray_char name; - varray_charinit(&name); - file_relativepath(MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)), &name); + varray_char name; + varray_charinit(&name); + file_relativepath(MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)), &name); + + size_t size = platform_maxpathsize(); + char buffer[size]; + + MorphoDirContents contents; + if (platform_directorycontentsinit(&contents, name.data)) { + varray_value list; + varray_valueinit(&list); + + while (platform_directorycontents(&contents, buffer, size)) { + value entry = object_stringfromcstring(buffer, strlen(buffer)); + if (MORPHO_ISSTRING(entry)) varray_valuewrite(&list, entry); + }; + + platform_directorycontentsclear(&contents); + + objectlist *clist = object_newlist(list.count, list.data); + if (clist) { + ret = MORPHO_OBJECT(clist); + varray_valuewrite(&list, ret); + morpho_bindobjects(v, list.count, list.data); + } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + + varray_valueclear(&list); + } else morpho_runtimeerror(v, FOLDER_NTFLDR); - size_t size = platform_maxpathsize(); - char buffer[size]; - - MorphoDirContents contents; - if (platform_directorycontentsinit(&contents, name.data)) { - varray_value list; - varray_valueinit(&list); - - while (platform_directorycontents(&contents, buffer, size)) { - value entry = object_stringfromcstring(buffer, strlen(buffer)); - if (MORPHO_ISSTRING(entry)) varray_valuewrite(&list, entry); - }; - - platform_directorycontentsclear(&contents); - - objectlist *clist = object_newlist(list.count, list.data); - if (clist) { - ret = MORPHO_OBJECT(clist); - varray_valuewrite(&list, ret); - morpho_bindobjects(v, list.count, list.data); - } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); - - varray_valueclear(&list); - } else morpho_runtimeerror(v, FOLDER_NTFLDR); - - varray_charclear(&name); - } else morpho_runtimeerror(v, FOLDER_EXPCTPATH); + varray_charclear(&name); return ret; } +/** Create a new folder; regular and recursive versions */ +static value _create(vm *v, int nargs, value *args, bool recurse) { + const char *path = MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)); + if (!platform_makedirectory(path, recurse)) morpho_runtimeerror(v, FOLDER_CREATEFAILED, path); + return MORPHO_NIL; +} + +value Folder_create(vm *v, int nargs, value *args) { + return _create(v, nargs, args, false); +} + +value Folder_createrecursive(vm *v, int nargs, value *args) { + return _create(v, nargs, args, true); +} + MORPHO_BEGINCLASS(Folder) -MORPHO_METHOD(FOLDER_ISFOLDER, Folder_isfolder, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FOLDER_CONTENTS, Folder_contents, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD_SIGNATURE(FOLDER_ISFOLDER, "Bool (String)", Folder_isfolder__string, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(FOLDER_ISFOLDER_DEPRECATED, "Bool (String)", Folder_isfolder__string, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(FOLDER_NORMALIZEPATH, "String (String)", Folder_normalizepath, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(FOLDER_CONTENTS, "List (String)", Folder_contents, MORPHO_FN_IO|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(FOLDER_CREATE, "(String)", Folder_create, MORPHO_FN_IO|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(FOLDER_CREATERECURSIVE, "(String)", Folder_createrecursive, MORPHO_FN_IO|MORPHO_FN_THROWS) MORPHO_ENDCLASS /* ********************************************************************** @@ -451,15 +509,19 @@ void file_initialize(void) { objectfiletype=object_addtype(&objectfiledefn); - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); - morpho_addfunction(FILE_CLASSNAME, FILE_CLASSNAME " (...)", file_constructor, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(FILE_CLASSNAME, "File (String)", file_constructor__string, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(FILE_CLASSNAME, "File (_)", file_constructor__filenamearg, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(FILE_CLASSNAME, "File (String,String)", file_constructor__string_string, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(FILE_CLASSNAME, "File (_,_)", file_constructor__args, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(FILE_CLASSNAME, "File ()", file_constructor__err, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(FILE_CLASSNAME, "File (_,_,...)", file_constructor__err, MORPHO_FN_CONSTRUCTOR, NULL); value fileclass=builtin_addclass(FILE_CLASSNAME, MORPHO_GETCLASSDEFINITION(File), objclass); object_setveneerclass(OBJECT_FILE, fileclass); - builtin_addclass(FOLDER_CLASSNAME, MORPHO_GETCLASSDEFINITION(Folder), MORPHO_NIL); + builtin_addclass(FOLDER_CLASSNAME, MORPHO_GETCLASSDEFINITION(Folder), objclass); morpho_defineerror(FILE_OPENFAILED, ERROR_HALT, FILE_OPENFAILED_MSG); morpho_defineerror(FILE_NEEDSFILENAME, ERROR_HALT, FILE_NEEDSFILENAME_MSG); @@ -470,6 +532,7 @@ void file_initialize(void) { morpho_defineerror(FOLDER_EXPCTPATH, ERROR_HALT, FOLDER_EXPCTPATH_MSG); morpho_defineerror(FOLDER_NTFLDR, ERROR_HALT, FOLDER_NTFLDR_MSG); + morpho_defineerror(FOLDER_CREATEFAILED, ERROR_HALT, FOLDER_CREATEFAILED_MSG); morpho_addfinalizefn(file_finalize); } diff --git a/src/classes/file.h b/src/classes/file.h index 36fd42245..749f0b262 100644 --- a/src/classes/file.h +++ b/src/classes/file.h @@ -56,8 +56,12 @@ typedef struct { #define FOLDER_CLASSNAME "Folder" -#define FOLDER_ISFOLDER "isfolder" -#define FOLDER_CONTENTS "contents" +#define FOLDER_ISFOLDER_DEPRECATED "isfolder" +#define FOLDER_ISFOLDER "isFolder" +#define FOLDER_CONTENTS "contents" +#define FOLDER_NORMALIZEPATH "normalizePath" +#define FOLDER_CREATE "create" +#define FOLDER_CREATERECURSIVE "createRecursive" /* ------------------------------------------------------- * File error messages @@ -87,12 +91,16 @@ typedef struct { #define FOLDER_NTFLDR "NtFldr" #define FOLDER_NTFLDR_MSG "Not a folder." +#define FOLDER_CREATEFAILED "FldrCrtFld" +#define FOLDER_CREATEFAILED_MSG "Couldn't create folder '%s'." + /* ------------------------------------------------------- * File interface * ------------------------------------------------------- */ bool file_getsize(FILE *f, size_t *s); -void file_setworkingdirectory(const char *script); +void file_setworkingdirectory(const char *path); +void file_getworkingdirectory(varray_char *path); FILE *file_openrelative(const char *fname, const char *mode); int file_readlineintovarray(FILE *f, varray_char *string); bool file_readintovarray(FILE *f, varray_char *string); diff --git a/src/classes/flt.c b/src/classes/flt.c index a1de4b667..e53fd2079 100644 --- a/src/classes/flt.c +++ b/src/classes/flt.c @@ -10,38 +10,39 @@ value Value_format(vm *v, int nargs, value *args) { value out = MORPHO_NIL; + varray_char str; - if (nargs==1 && - MORPHO_ISSTRING(MORPHO_GETARG(args, 0))) { - varray_char str; - varray_charinit(&str); - - if (format_printtobuffer(MORPHO_SELF(args), - MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)), - &str)) { - - out = object_stringfromvarraychar(&str); - if (MORPHO_ISOBJECT(out)) morpho_bindobjects(v, 1, &out); - } else morpho_runtimeerror(v, VALUE_INVLDFRMT); + varray_charinit(&str); + + if (format_printtobuffer(MORPHO_SELF(args), + MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)), + &str)) { - varray_charclear(&str); - } else { - morpho_runtimeerror(v, VALUE_FRMTARG); - } + out = object_stringfromvarraychar(&str); + if (MORPHO_ISOBJECT(out)) morpho_bindobjects(v, 1, &out); + } else morpho_runtimeerror(v, VALUE_INVLDFRMT); + + varray_charclear(&str); return out; } +value Value_format__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, VALUE_FRMTARG); + return MORPHO_NIL; +} + /* ********************************************************************** * Float veneer class * ********************************************************************** */ MORPHO_BEGINCLASS(Float) -MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_RESPONDSTO_METHOD, Object_respondsto, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_INVOKE_METHOD, Object_invoke, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_FORMAT_METHOD, Value_format, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_RESPONDSTO_METHOD, Object_respondsto, MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_INVOKE_METHOD, Object_invoke, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_FORMAT_METHOD, "String (String)", Value_format, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_FORMAT_METHOD, "Nil (...)", Value_format__err, MORPHO_FN_THROWS) MORPHO_ENDCLASS /* ********************************************************************** diff --git a/src/classes/function.c b/src/classes/function.c index a45912d89..2e948fff6 100644 --- a/src/classes/function.c +++ b/src/classes/function.c @@ -56,6 +56,7 @@ void object_functioninit(objectfunction *func) { func->nopt=0; func->parent=NULL; func->creg=-1; + func->isrecursive=false; func->nregs=0; varray_valueinit(&func->konst); varray_varray_upvalueinit(&func->prototype); @@ -162,6 +163,16 @@ void function_setsignature(objectfunction *func, value *signature) { signature_set(&func->sig, function_countpositionalargs(func), signature); } +/** Sets the return type of a function */ +void function_setreturntype(objectfunction *func, value type) { + signature_setreturntype(&func->sig, type); +} + +/** Get the return type of a function */ +value function_getreturntype(objectfunction *func) { + return signature_getreturntype(&func->sig); +} + /** Returns true if any of the parameters are typed */ bool function_hastypedparameters(objectfunction *func) { return signature_istyped(&func->sig); @@ -192,8 +203,45 @@ value Function_tostring(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Function) -MORPHO_METHOD(MORPHO_TOSTRING_METHOD, Function_tostring, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_TOSTRING_METHOD, Function_tostring, MORPHO_FN_ALLOCATES), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO) +MORPHO_ENDCLASS + +/* ********************************************************************** + * objectcallable definitions + * ********************************************************************** */ + +/** A callable object */ +typedef struct { + object obj; + value name; +} objectcallable; + +size_t objectcallable_sizefn(object *obj) { + return sizeof(objectcallable); +} + +void objectcallable_printfn(object *obj, void *v) { + objectcallable *f = (objectcallable *) obj; + if (f) morpho_printf(v, "", (MORPHO_ISNIL(f->name) ? "" : MORPHO_GETCSTRING(f->name))); +} + +objecttypedefn objectcallabledefn = { + .printfn=objectcallable_printfn, + .markfn=NULL, + .freefn=NULL, + .sizefn=objectcallable_sizefn, + .hashfn=NULL, + .cmpfn=NULL +}; + +/* ********************************************************************** + * Callable class + * ********************************************************************** */ + +MORPHO_BEGINCLASS(Callable) +MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_TOSTRING_METHOD, Function_tostring, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES) MORPHO_ENDCLASS /* ********************************************************************** @@ -201,17 +249,23 @@ MORPHO_ENDCLASS * ********************************************************************** */ objecttype objectfunctiontype; +objecttype objectcallabletype; void function_initialize(void) { // Create function object type objectfunctiontype=object_addtype(&objectfunctiondefn); - // Locate the Object class to use as the parent class of Function - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + objectcallabletype=object_addtype(&objectcallabledefn); + + // Locate the Object class to use as the parent class of Callable + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); + + // Create callable class + value callableclass=builtin_addclass(CALLABLE_CLASSNAME, MORPHO_GETCLASSDEFINITION(Callable), objclass); + object_setveneerclass(objectcallabletype, callableclass); // Create function veneer class - value functionclass=builtin_addclass(FUNCTION_CLASSNAME, MORPHO_GETCLASSDEFINITION(Function), objclass); + value functionclass=builtin_addclass(FUNCTION_CLASSNAME, MORPHO_GETCLASSDEFINITION(Function), callableclass); object_setveneerclass(OBJECT_FUNCTION, functionclass); // No constructor as objectfunctions are generated by the compiler diff --git a/src/classes/function.h b/src/classes/function.h index 94cb34973..688c709c5 100644 --- a/src/classes/function.h +++ b/src/classes/function.h @@ -34,6 +34,7 @@ typedef struct sobjectfunction { value name; indx entry; int creg; // Closure register + bool isrecursive; struct sobjectfunction *parent; int nregs; objectclass *klass; // Parent class for methods @@ -55,6 +56,8 @@ typedef struct sobjectfunction { #define FUNCTION_CLASSNAME "Function" +#define CALLABLE_CLASSNAME "Callable" + /* ------------------------------------------------------- * Function error messages * ------------------------------------------------------- */ @@ -80,6 +83,9 @@ bool function_isclosure(objectfunction *func); void function_setsignature(objectfunction *func, value *signature); bool function_hastypedparameters(objectfunction *func); +void function_setreturntype(objectfunction *func, value type); +value function_getreturntype(objectfunction *func); + void objectfunction_printfn(object *obj, void *v); void function_initialize(void); diff --git a/src/classes/instance.c b/src/classes/instance.c index 2f68941c9..c1de66e06 100644 --- a/src/classes/instance.c +++ b/src/classes/instance.c @@ -321,19 +321,19 @@ value Object_linearization(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Object) -MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Object_getindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Object_setindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SUPER_METHOD, Object_super, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_RESPONDSTO_METHOD, Object_respondsto, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_HAS_METHOD, Object_has, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_INVOKE_METHOD, Object_invoke, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_COUNT_METHOD, Object_count, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Object_enumerate, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SERIALIZE_METHOD, Object_serialize, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Object_clone, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_LINEARIZATION_METHOD, Object_linearization, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Object_getindex, MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Object_setindex, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_SUPER_METHOD, Object_super, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_RESPONDSTO_METHOD, Object_respondsto, MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_HAS_METHOD, Object_has, MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_INVOKE_METHOD, Object_invoke, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO), +MORPHO_METHOD(MORPHO_COUNT_METHOD, Object_count, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Object_enumerate, MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_SERIALIZE_METHOD, Object_serialize, MORPHO_FN_NONE), +MORPHO_METHOD(MORPHO_CLONE_METHOD, Object_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_LINEARIZATION_METHOD, Object_linearization, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES) MORPHO_ENDCLASS /* ********************************************************************** diff --git a/src/classes/int.c b/src/classes/int.c index 810fa04ab..ccb445bc9 100644 --- a/src/classes/int.c +++ b/src/classes/int.c @@ -16,11 +16,11 @@ * ********************************************************************** */ MORPHO_BEGINCLASS(Int) -MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_RESPONDSTO_METHOD, Object_respondsto, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_INVOKE_METHOD, Object_invoke, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_FORMAT_METHOD, Value_format, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_RESPONDSTO_METHOD, Object_respondsto, MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_INVOKE_METHOD, Object_invoke, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_FORMAT_METHOD, "String (_)", Value_format, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS) MORPHO_ENDCLASS /* ********************************************************************** diff --git a/src/classes/invocation.c b/src/classes/invocation.c index c0a1a65bd..152b72760 100644 --- a/src/classes/invocation.c +++ b/src/classes/invocation.c @@ -62,34 +62,35 @@ objectinvocation *object_newinvocation(value receiver, value method) { /** Creates a new invocation object */ value invocation_constructor(vm *v, int nargs, value *args) { value out=MORPHO_NIL; + value receiver = MORPHO_GETARG(args, 0); + value selector = MORPHO_GETARG(args, 1); + + if (!MORPHO_ISOBJECT(receiver) || !MORPHO_ISSTRING(selector)) { + morpho_runtimeerror(v, INVOCATION_ARGS); + return MORPHO_NIL; + } + + value method = MORPHO_NIL; + objectclass *klass=morpho_lookupclass(receiver); + + if (dictionary_get(&klass->methods, selector, &method)) { + objectinvocation *new = object_newinvocation(receiver, method); - if (nargs==2) { - value receiver = MORPHO_GETARG(args, 0); - value selector = MORPHO_GETARG(args, 1); - - if (!MORPHO_ISOBJECT(receiver) || !MORPHO_ISSTRING(selector)) { - morpho_runtimeerror(v, INVOCATION_ARGS); - return MORPHO_NIL; - } - - value method = MORPHO_NIL; - - objectclass *klass=morpho_lookupclass(receiver); - - if (dictionary_get(&klass->methods, selector, &method)) { - objectinvocation *new = object_newinvocation(receiver, method); - - if (new) { - out = MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); - } - - } else morpho_runtimeerror(v, INVOCATION_ARGS); + if (new) { + out = MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + } return out; } +/** Raises a constructor error */ +value invocation_constructor__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, INVOCATION_ARGS); + return MORPHO_NIL; +} + /** Converts to a string for string interpolation */ value Invocation_tostring(vm *v, int nargs, value *args) { objectinvocation *inv=MORPHO_GETINVOCATION(MORPHO_SELF(args)); @@ -129,9 +130,9 @@ value Invocation_clone(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Invocation) -MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_TOSTRING_METHOD, Invocation_tostring, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Invocation_clone, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_TOSTRING_METHOD, "String ()", Invocation_tostring, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_CLONE_METHOD, "Invocation ()", Invocation_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS) MORPHO_ENDCLASS /* ********************************************************************** @@ -144,12 +145,12 @@ void invocation_initialize(void) { // Create invocation object type objectinvocationtype=object_addtype(&objectinvocationdefn); - // Locate the Object class to use as the parent class of Invocation - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + // Locate the Callable class to use as the parent class of Closure + value objclass = builtin_findclassfromcstring(CALLABLE_CLASSNAME); // Invocation constructor function - morpho_addfunction(INVOCATION_CLASSNAME, INVOCATION_CLASSNAME " (...)", invocation_constructor, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(INVOCATION_CLASSNAME, "Invocation (_,_)", invocation_constructor, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(INVOCATION_CLASSNAME, "Invocation (...)", invocation_constructor__err, MORPHO_FN_CONSTRUCTOR, NULL); // Create invocation veneer class value invocationclass=builtin_addclass(INVOCATION_CLASSNAME, MORPHO_GETCLASSDEFINITION(Invocation), objclass); @@ -157,5 +158,4 @@ void invocation_initialize(void) { // Invocation error messages morpho_defineerror(INVOCATION_ARGS, ERROR_HALT, INVOCATION_ARGS_MSG); - morpho_defineerror(INVOCATION_METHOD, ERROR_HALT, INVOCATION_METHOD_MSG); } diff --git a/src/classes/invocation.h b/src/classes/invocation.h index 6f2b6aa8c..9f11184a0 100644 --- a/src/classes/invocation.h +++ b/src/classes/invocation.h @@ -52,9 +52,6 @@ objectinvocation *object_newinvocation(value receiver, value method); #define INVOCATION_ARGS "InvocationArgs" #define INVOCATION_ARGS_MSG "Invocation must be called with an object and a method name as arguments." -#define INVOCATION_METHOD "InvocationMethod" -#define INVOCATION_METHOD_MSG "Method not found." - /* ------------------------------------------------------- * Invocation interface * ------------------------------------------------------- */ diff --git a/src/classes/json.c b/src/classes/json.c index 1c0b785ba..4b347d662 100644 --- a/src/classes/json.c +++ b/src/classes/json.c @@ -566,39 +566,46 @@ bool json_tostring(vm *v, value in, value *out) { value JSON_parse(vm *v, int nargs, value *args) { value out = MORPHO_NIL; - if (nargs==1 && MORPHO_ISSTRING(MORPHO_GETARG(args, 0))) { - char *src = MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)); - varray_value objects; - varray_valueinit(&objects); - error err; - error_init(&err); - - if (json_parse(src, &err, &out, &objects)) { - morpho_bindobjects(v, objects.count, objects.data); - } else { - morpho_runtimeerror(v, err.id); - } - varray_valueclear(&objects); - } else morpho_runtimeerror(v, JSON_PRSARGS); + char *src = MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)); + varray_value objects; + varray_valueinit(&objects); + error err; + error_init(&err); + + if (json_parse(src, &err, &out, &objects)) { + morpho_bindobjects(v, objects.count, objects.data); + } else { + morpho_runtimeerror(v, err.id); + } + varray_valueclear(&objects); return out; } +value JSON_parse__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, JSON_PRSARGS); + return MORPHO_NIL; +} + value JSON_tostring(vm *v, int nargs, value *args) { value out = MORPHO_NIL; - if (nargs==1) { - if (json_tostring(v, MORPHO_GETARG(args, 0), &out)) { - morpho_bindobjects(v, 1, &out); - } + if (json_tostring(v, MORPHO_GETARG(args, 0), &out)) { + morpho_bindobjects(v, 1, &out); } return out; } +value JSON_tostring__err(vm *v, int nargs, value *args) { + return MORPHO_NIL; +} + MORPHO_BEGINCLASS(JSON) -MORPHO_METHOD(JSON_PARSEMETHOD, JSON_parse, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_TOSTRING_METHOD, JSON_tostring, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD_SIGNATURE(JSON_PARSEMETHOD, "(String)", JSON_parse, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(JSON_PARSEMETHOD, "(...)", JSON_parse__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_TOSTRING_METHOD, "(_)", JSON_tostring, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_TOSTRING_METHOD, "(...)", JSON_tostring__err, MORPHO_FN_THROWS) MORPHO_ENDCLASS /* ********************************************************************** @@ -607,8 +614,7 @@ MORPHO_ENDCLASS void json_initialize(void) { // Locate the Object class to use as the parent class of JSON - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); // JSON class builtin_addclass(JSON_CLASSNAME, MORPHO_GETCLASSDEFINITION(JSON), objclass); diff --git a/src/classes/list.c b/src/classes/list.c index 00facedc0..790a2a830 100644 --- a/src/classes/list.c +++ b/src/classes/list.c @@ -99,16 +99,13 @@ bool list_insert(objectlist *list, int indx, int nval, value *vals) { * @param[in] val the entry to remove * @returns true on success */ bool list_remove(objectlist *list, value val) { - /* Find the element */ - for (unsigned int i=0; ival.count; i++) { - if (MORPHO_ISEQUAL(list->val.data[i], val)) { /* Remove it if we're not at the end of the list */ - if (ival.count-1) memmove(list->val.data+i, list->val.data+i+1, sizeof(value)*(list->val.count-i-1)); - list->val.count--; - return true; - } - } + unsigned int i; - return false; + if (!list_find(list, val, &i)) return false; + + if (ival.count-1) memmove(list->val.data+i, list->val.data+i+1, sizeof(value)*(list->val.count-i-1)); + list->val.count--; + return true; } /** Gets an element from a list @@ -130,35 +127,45 @@ int list_sortfunction(const void *a, const void *b) { } /** Sort the contents of a list */ -void list_sort(objectlist *list) { - qsort(list->val.data, list->val.count, sizeof(value), list_sortfunction); +void list_sortcontents(value *values, size_t count) { + qsort(values, count, sizeof(value), list_sortfunction); } -static vm *list_sortwithfn_vm; -static value list_sortwithfn_fn; -static bool list_sortwithfn_err; - -/** Sort function for list_sort */ -int list_sortfunctionwfn(const void *a, const void *b) { - value args[2] = {*(value *) a, *(value *) b}; - value ret; +/** Sort the contents of a list */ +void list_sort(objectlist *list) { + list_sortcontents(list->val.data, list->val.count); +} - if (morpho_call(list_sortwithfn_vm, list_sortwithfn_fn, 2, args, &ret)) { +/** Sort the contents of a list using a re-entrant comparison function */ +typedef struct { + vm *v; + value cmpfn; + bool errq; +} _sortfninfo; + +static int _sortfn(const void *a, const void *b, void *context) { + _sortfninfo *info = (_sortfninfo *) context; + value ret, args[2] = {*(value *) a, *(value *) b}; + + if (morpho_call(info->v, info->cmpfn, 2, args, &ret)) { if (MORPHO_ISINTEGER(ret)) return MORPHO_GETINTEGERVALUE(ret); if (MORPHO_ISFLOAT(ret)) return morpho_comparevalue(MORPHO_FLOAT(0), ret); } - - list_sortwithfn_err=true; + + info->errq=true; return 0; } +/** Sort a list of values */ +bool list_sortcontentswithfn(vm *v, value cmpfn, value *values, size_t count) { + _sortfninfo info = { .v = v, .cmpfn = cmpfn, .errq=false }; + platform_qsort_r(values, count, sizeof(value), &info, _sortfn); + return !info.errq; +} + /** Sort the contents of a list */ -bool list_sortwithfn(vm *v, value fn, objectlist *list) { - list_sortwithfn_vm=v; - list_sortwithfn_fn=fn; - list_sortwithfn_err=false; - qsort(list->val.data, list->val.count, sizeof(value), list_sortfunctionwfn); - return !list_sortwithfn_err; +bool list_sortwithfn(vm *v, value cmpfn, objectlist *list) { + return list_sortcontentswithfn(v, cmpfn, list->val.data, list->val.count); } /** Sort function for list_order */ @@ -172,10 +179,10 @@ int list_orderfunction(const void *a, const void *b) { return -morpho_comparevalue(((listorderstruct *) a)->val, ((listorderstruct *) b)->val); } -/* Returns a list of indices giving the ordering of a list */ -objectlist *list_order(objectlist *list) { +/* Returns a tuple of indices giving the ordering of a list */ +objecttuple *list_order(objectlist *list) { listorderstruct *order = MORPHO_MALLOC(list->val.count*sizeof(listorderstruct)); - objectlist *new = NULL; + objecttuple *new = NULL; if (order) { for (unsigned int i=0; ival.count; i++) { @@ -184,12 +191,11 @@ objectlist *list_order(objectlist *list) { } qsort(order, list->val.count, sizeof(listorderstruct), list_orderfunction); - new=object_newlist(list->val.count, NULL); + new=object_newtuple(list->val.count, NULL); if (new) { for (unsigned int i=0; ival.count; i++) { - new->val.data[i]=MORPHO_INTEGER(order[i].indx); + new->tuple[i]=MORPHO_INTEGER(order[i].indx); } - new->val.count=list->val.count; } MORPHO_FREE(order); @@ -208,10 +214,13 @@ void list_reverse(objectlist *list) { } } -/** Tests if a value is a member of a list */ -bool list_ismember(objectlist *list, value v) { +/** Finds a value in a list and optionally returns its index. */ +bool list_find(objectlist *list, value v, unsigned int *indx) { for (unsigned int i=0; ival.count; i++) { - if (MORPHO_ISEQUAL(list->val.data[i], v)) return true; + if (MORPHO_ISEQUAL(list->val.data[i], v)) { + if (indx) *indx=i; + return true; + } } return false; } @@ -426,46 +435,58 @@ value List_pop(vm *v, int nargs, value *args) { return out; } -/** Get an element */ -value List_getindex(vm *v, int nargs, value *args) { +/** Get an element by integer index */ +value List_getindex__int(vm *v, int nargs, value *args) { objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); value out=MORPHO_NIL; + int i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - if (nargs==1) { - if (MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - int i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + if (!list_getelement(slf, i, &out)) { + morpho_runtimeerror(v, VM_OUTOFBOUNDS); + } - if (!list_getelement(slf, i, &out)) { - morpho_runtimeerror(v, VM_OUTOFBOUNDS); - } - } else { - objectarrayerror err = getslice(&MORPHO_SELF(args),&list_slicedim,&list_sliceconstructor,&list_slicecopy,nargs,&MORPHO_GETARG(args, 0),&out); - if (err!=ARRAY_OK) MORPHO_RAISE(v, array_to_list_error(err) ); - if (MORPHO_ISOBJECT(out)){ - morpho_bindobjects(v,1,&out); - } else MORPHO_RAISE(v, VM_NONNUMINDX); + return out; +} - } - } else MORPHO_RAISE(v, LIST_NUMARGS) +/** Get a slice-like selection */ +value List_getindex__slice(vm *v, int nargs, value *args) { + value out=MORPHO_NIL; + objectarrayerror err = getslice(&MORPHO_SELF(args), &list_slicedim, &list_sliceconstructor, &list_slicecopy, nargs, &MORPHO_GETARG(args, 0), &out); + if (err!=ARRAY_OK) MORPHO_RAISE(v, array_to_list_error(err) ); + if (MORPHO_ISOBJECT(out)) { + morpho_bindobjects(v,1,&out); + } else MORPHO_RAISE(v, VM_NONNUMINDX); return out; } -/** Sets an element */ -value List_setindex(vm *v, int nargs, value *args) { +value List_getindex__err(vm *v, int nargs, value *args) { + MORPHO_RAISE(v, LIST_NUMARGS); + return MORPHO_NIL; +} + +value List_getindex(vm *v, int nargs, value *args) { + if (nargs!=1) return List_getindex__err(v, nargs, args); + if (MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) return List_getindex__int(v, nargs, args); + return List_getindex__slice(v, nargs, args); +} + +/** Sets an element by integer index */ +value List_setindex__int(vm *v, int nargs, value *args) { objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); + int i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - if (nargs==2) { - if (MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - int i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - if (ival.count) slf->val.data[i]=MORPHO_GETARG(args, 1); - else morpho_runtimeerror(v, VM_OUTOFBOUNDS); - } else morpho_runtimeerror(v, SETINDEX_ARGS); - } else morpho_runtimeerror(v, SETINDEX_ARGS); + if (ival.count) slf->val.data[i]=MORPHO_GETARG(args, 1); + else morpho_runtimeerror(v, VM_OUTOFBOUNDS); return MORPHO_SELF(args); } +value List_setindex__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, SETINDEX_ARGS); + return MORPHO_NIL; +} + /** Print a list */ value List_print(vm *v, int nargs, value *args) { value self = MORPHO_SELF(args); @@ -511,22 +532,24 @@ value List_tostring(vm *v, int nargs, value *args) { value List_enumerate(vm *v, int nargs, value *args) { objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); value out=MORPHO_NIL; - - if (nargs==1 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - - if (n<0) { - out=MORPHO_INTEGER(slf->val.count); - } else if (nval.count) { - return slf->val.data[n]; - } else { - morpho_runtimeerror(v, VM_OUTOFBOUNDS); - } - } else MORPHO_RAISE(v, ENUMERATE_ARGS); + int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + if (n<0) { + out=MORPHO_INTEGER(slf->val.count); + } else if (nval.count) { + return slf->val.data[n]; + } else { + morpho_runtimeerror(v, VM_OUTOFBOUNDS); + } return out; } +value List_enumerate__err(vm *v, int nargs, value *args) { + MORPHO_RAISE(v, ENUMERATE_ARGS); + return MORPHO_NIL; +} + /** Get number of entries */ value List_count(vm *v, int nargs, value *args) { objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); @@ -536,6 +559,20 @@ value List_count(vm *v, int nargs, value *args) { /** Generate a list of n-tuples from a list */ value List_tuples(vm *v, int nargs, value *args) { + objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); + return list_generatetuples(v, slf, 2, MORPHO_TUPLEMODE); +} + +value List_tuples__int(vm *v, int nargs, value *args) { + objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); + unsigned int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + if (n<2) n=2; + + return list_generatetuples(v, slf, n, MORPHO_TUPLEMODE); +} + +value List_tuples__fallback(vm *v, int nargs, value *args) { objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); unsigned int n=2; @@ -549,6 +586,21 @@ value List_tuples(vm *v, int nargs, value *args) { /** Generate a list of n-tuples from a list */ value List_sets(vm *v, int nargs, value *args) { + objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); + return list_generatetuples(v, slf, 2, MORPHO_SETMODE); +} + +value List_sets__int(vm *v, int nargs, value *args) { + objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); + unsigned int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + if (n<2) n=2; + if (n>slf->val.capacity) n = slf->val.capacity; + + return list_generatetuples(v, slf, n, MORPHO_SETMODE); +} + +value List_sets__fallback(vm *v, int nargs, value *args) { objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); unsigned int n=2; @@ -572,20 +624,17 @@ value List_clone(vm *v, int nargs, value *args) { } /** Joins two lists together */ -value List_join(vm *v, int nargs, value *args) { +value List_join__list(vm *v, int nargs, value *args) { objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); value out = MORPHO_NIL; - if (nargs==1 && MORPHO_ISLIST(MORPHO_GETARG(args, 0))) { - objectlist *operand = MORPHO_GETLIST(MORPHO_GETARG(args, 0)); - objectlist *new = list_concatenate(slf, operand); + objectlist *operand = MORPHO_GETLIST(MORPHO_GETARG(args, 0)); + objectlist *new = list_concatenate(slf, operand); - if (new) { - out = MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } - - } else morpho_runtimeerror(v, LIST_ADDARGS); + if (new) { + out = MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } return out; } @@ -594,36 +643,21 @@ value List_join(vm *v, int nargs, value *args) { value List_roll(vm *v, int nargs, value *args) { objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); value out = MORPHO_NIL; + int roll; + morpho_valuetoint(MORPHO_GETARG(args, 0), &roll); - if (nargs==1 && - MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { - int roll; - morpho_valuetoint(MORPHO_GETARG(args, 0), &roll); - - objectlist *new = list_roll(slf, roll); + objectlist *new = list_roll(slf, roll); - if (new) { - out = MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } - - } else morpho_runtimeerror(v, LIST_ADDARGS); + if (new) { + out = MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } return out; } -/** Sorts a list */ -value XList_sort(vm *v, int nargs, value *args) { - objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); - - if (nargs==0) { - list_sort(slf); - } else if (nargs==1 && MORPHO_ISCALLABLE(MORPHO_GETARG(args, 0))) { - if (!list_sortwithfn(v, MORPHO_GETARG(args, 0), slf)) { - morpho_runtimeerror(v, LIST_SRTFN); - } - } - +value List_roll__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, LIST_ADDARGS); return MORPHO_NIL; } @@ -641,12 +675,12 @@ value List_sort_fn(vm *v, int nargs, value *args) { return MORPHO_NIL; } -/** Returns a list of indices that would sort the list self */ +/** Returns a tuple of indices that would sort the list self */ value List_order(vm *v, int nargs, value *args) { objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); value out=MORPHO_NIL; - objectlist *new=list_order(slf); + objecttuple *new=list_order(slf); if (new) { out=MORPHO_OBJECT(new); morpho_bindobjects(v, 1, &out); @@ -667,37 +701,49 @@ value List_reverse(vm *v, int nargs, value *args) { /** Tests if a list has a value as a member */ value List_ismember(vm *v, int nargs, value *args) { objectlist *slf = MORPHO_GETLIST(MORPHO_SELF(args)); + return MORPHO_BOOL(list_find(slf, MORPHO_GETARG(args, 0), NULL)); +} - if (nargs==1) { - return MORPHO_BOOL(list_ismember(slf, MORPHO_GETARG(args, 0))); - } else morpho_runtimeerror(v, ISMEMBER_ARG, 1, nargs); - +value List_ismember__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, ISMEMBER_ARG, 1, nargs); return MORPHO_NIL; } MORPHO_BEGINCLASS(List) -MORPHO_METHOD(MORPHO_APPEND_METHOD, List_append, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(LIST_REMOVE_METHOD, List_remove, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(LIST_INSERT_METHOD, List_insert, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(LIST_POP_METHOD, List_pop, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_GETINDEX_METHOD, List_getindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SETINDEX_METHOD, List_setindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, List_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_TOSTRING_METHOD, List_tostring, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, List_enumerate, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_COUNT_METHOD, List_count, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(LIST_TUPLES_METHOD, List_tuples, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(LIST_SETS_METHOD, List_sets, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, List_clone, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_APPEND_METHOD, List_append, MORPHO_FN_MUTATES), +MORPHO_METHOD(LIST_REMOVE_METHOD, List_remove, MORPHO_FN_MUTATES), +MORPHO_METHOD(LIST_INSERT_METHOD, List_insert, MORPHO_FN_MUTATES), +MORPHO_METHOD(LIST_POP_METHOD, List_pop, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, " (Int)", List_getindex__int, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "List (_)", List_getindex__slice, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "Nil (...)", List_getindex__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_SETINDEX_METHOD, "(Int,_)", List_setindex__int, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MORPHO_SETINDEX_METHOD, "Nil (...)", List_setindex__err, MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_PRINT_METHOD, List_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_TOSTRING_METHOD, "String ()", List_tostring, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ENUMERATE_METHOD, " (Int)", List_enumerate, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ENUMERATE_METHOD, "Nil (...)", List_enumerate__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_COUNT_METHOD, "Int ()", List_count, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(LIST_TUPLES_METHOD, "List ()", List_tuples, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(LIST_TUPLES_METHOD, "List (Int)", List_tuples__int, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(LIST_TUPLES_METHOD, "List (...)", List_tuples__fallback, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(LIST_SETS_METHOD, "List ()", List_sets, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(LIST_SETS_METHOD, "List (Int)", List_sets__int, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(LIST_SETS_METHOD, "List (...)", List_sets__fallback, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_CLONE_METHOD, "List ()", List_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), //MORPHO_METHOD(MORPHO_ADD_METHOD, List_add, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_JOIN_METHOD, List_join, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ROLL_METHOD, List_roll, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD_SIGNATURE(LIST_SORT_METHOD, "()", List_sort, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD_SIGNATURE(LIST_SORT_METHOD, "(_)", List_sort_fn, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(LIST_ORDER_METHOD, List_order, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(LIST_REVERSE_METHOD, List_reverse, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(LIST_ISMEMBER_METHOD, List_ismember, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CONTAINS_METHOD, List_ismember, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD_SIGNATURE(MORPHO_JOIN_METHOD, "List (List)", List_join__list, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ROLL_METHOD, "List (Int)", List_roll, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ROLL_METHOD, "List (Float)", List_roll, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ROLL_METHOD, "Nil (...)", List_roll__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(LIST_SORT_METHOD, "Nil ()", List_sort, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(LIST_SORT_METHOD, "Nil (Callable)", List_sort_fn, MORPHO_FN_MUTATES|MORPHO_FN_REENTRANT|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(LIST_ORDER_METHOD, "Tuple ()", List_order, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(LIST_REVERSE_METHOD, "Nil ()", List_reverse, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(LIST_ISMEMBER_METHOD, "Bool (_)", List_ismember, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(LIST_ISMEMBER_METHOD, "Nil (...)", List_ismember__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_CONTAINS_METHOD, "Bool (_)", List_ismember, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_CONTAINS_METHOD, "Nil (...)", List_ismember__err, MORPHO_FN_THROWS) MORPHO_ENDCLASS /* ********************************************************************** @@ -711,8 +757,7 @@ void list_initialize(void) { objectlisttype=object_addtype(&objectlistdefn); // Locate the Object class to use as the parent class of List - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); // Define List class value listclass=builtin_addclass(LIST_CLASSNAME, MORPHO_GETCLASSDEFINITION(List), objclass); diff --git a/src/classes/list.h b/src/classes/list.h index ba7feb88d..393f25daa 100644 --- a/src/classes/list.h +++ b/src/classes/list.h @@ -75,9 +75,15 @@ value List_getindex(vm *v, int nargs, value *args); bool list_resize(objectlist *list, int size); void list_append(objectlist *list, value v); +bool list_remove(objectlist *list, value val); +bool list_find(objectlist *list, value v, unsigned int *indx); unsigned int list_length(objectlist *list); bool list_getelement(objectlist *list, int i, value *out); +void list_sortcontents(value *values, size_t count); void list_sort(objectlist *list); +bool list_sortcontentswithfn(vm *v, value cmpfn, value *values, size_t count); +bool list_sortwithfn(vm *v, value cmpfn, objectlist *list); + objectlist *list_clone(objectlist *list); void list_initialize(void); diff --git a/src/classes/metafunction.c b/src/classes/metafunction.c index c948fb167..310992036 100644 --- a/src/classes/metafunction.c +++ b/src/classes/metafunction.c @@ -5,29 +5,14 @@ */ #include +#include #include "morpho.h" #include "classes.h" #include "common.h" -/* ********************************************************************** - * Metafunction opcodes - * ********************************************************************** */ - -enum { - MF_RESOLVE, - MF_FAIL, - MF_CHECKNARGSNEQ, - MF_CHECKNARGSLT, - MF_CHECKVALUE, - MF_CHECKOBJECT, - MF_CHECKINSTANCE, - MF_BRANCH, - MF_BRANCHNARGS, - MF_BRANCHVALUETYPE, - MF_BRANCHOBJECTTYPE, - MF_BRANCHINSTANCE -}; +#define ERR_CHECK(expr, label) do { if (!(expr)) goto label; } while (0) +#define ERR_CHECK_RETURN(expr) do { if (!(expr)) return false; } while (0) /* ********************************************************************** * objectmetafunction definitions @@ -43,11 +28,7 @@ void objectmetafunction_freefn(object *obj) { void objectmetafunction_markfn(object *obj, void *v) { objectmetafunction *f = (objectmetafunction *) obj; morpho_markvalue(v, f->name); // Mark the name - - for (int i=0; iresolver.count; i++) { // Mark any functions in the resolver - mfinstruction *instr = &f->resolver.data[i]; - if (instr->opcode==MF_RESOLVE) morpho_markvalue(v,instr->data.resolvefn); - } + morpho_markvarrayvalue(v, &f->fns); // Preserve implementations while building/frozen } size_t objectmetafunction_sizefn(object *obj) { @@ -81,8 +62,10 @@ objectmetafunction *object_newmetafunction(value name) { new->name=MORPHO_NIL; if (MORPHO_ISSTRING(name)) new->name=object_clonestring(name); new->klass=NULL; + new->state=METAFUNCTION_BUILDING; varray_valueinit(&new->fns); varray_mfinstructioninit(&new->resolver); + new->entry=0; } return new; @@ -112,34 +95,56 @@ bool metafunction_wrap(value name, value fn, value *out) { return true; } -/** Adds a function to a metafunction */ -bool metafunction_add(objectmetafunction *f, value fn) { - return varray_valuewrite(&f->fns, fn); +/** Merges an incoming callable into an existing entry. + * @param[in] name name of the callable + * @param[in] existing the existing dictionary entry + * @param[in] incoming the callable to merge into the entry + * @param[in] klass owner class; if non-NULL, an existing metafunction must either be unowned or already belong to this class + * @param[out] out the merged entry + * @returns true on success */ +bool metafunction_merge(value name, value existing, value incoming, objectclass *klass, value *out) { + value entry=existing; + + if (MORPHO_ISNIL(entry)) { + *out=incoming; + return true; + } + + if (!MORPHO_ISMETAFUNCTION(entry)) { + if (!metafunction_wrap(name, entry, &entry)) return false; + } + + objectmetafunction *dest = MORPHO_GETMETAFUNCTION(entry); + if (klass) { + if (dest->klass && dest->klass!=klass) return false; + dest->klass=klass; + } + + if (MORPHO_ISMETAFUNCTION(incoming)) { + objectmetafunction *src = MORPHO_GETMETAFUNCTION(incoming); + for (int i=0; ifns.count; i++) { + if (!metafunction_add(dest, src->fns.data[i])) return false; + } + } else { + if (!metafunction_add(dest, incoming)) return false; + } + + *out=entry; + return true; } -/** Extracts a type from a value */ -bool metafunction_typefromvalue(value v, value *out) { - objectclass *clss = NULL; - - if (MORPHO_ISINSTANCE(v)) { - clss=MORPHO_GETINSTANCE(v)->klass; - } else if (MORPHO_ISOBJECT(v)) { - clss = object_getveneerclass(MORPHO_GETOBJECT(v)->type); - } else clss = value_getveneerclass(v); - - if (clss) *out = MORPHO_OBJECT(clss); - return clss; +/** Adds a function to a metafunction */ +bool metafunction_add(objectmetafunction *f, value fn) { + if (f->state==METAFUNCTION_FROZEN) { + metafunction_clearinstructions(f); + f->state=METAFUNCTION_BUILDING; + } + return varray_valueadd(&f->fns, &fn, 1); } /** Checks if val matches a given type */ bool metafunction_matchtype(value type, value val) { - value match; - if (!metafunction_typefromvalue(val, &match)) return false; - - if (MORPHO_ISNIL(type) || // If type is unset, we always match - MORPHO_ISEQUAL(type, match)) return true; // Or if the types are the same - - return false; + return value_istype(val, type); } /** Sets the parent class of a metafunction */ @@ -166,6 +171,49 @@ bool metafunction_matchset(objectmetafunction *fn, int n, value *fns) { return true; } +/** Infer the return type from the contents of a metafunction, if known */ +void metafunction_inferreturntype(objectmetafunction *fn, value *type) { + value rtype = MORPHO_NIL; + + for (int i=0; ifns.count; i++) { + signature *sig = metafunction_getsignature(fn->fns.data[i]); + if (i==0) { + rtype=sig->ret; + } else { + if (!MORPHO_ISEQUAL(sig->ret,rtype)) rtype=MORPHO_NIL; + } + } + + *type=rtype; +} + +/** Clears the compiled code from a given metafunction. */ +void metafunction_clearinstructions(objectmetafunction *fn) { + varray_mfinstructionclear(&fn->resolver); + fn->entry=0; +} + +/** Finalizes a metafunction. */ +bool metafunction_finalize(objectmetafunction *fn, error *err) { + if (fn->state==METAFUNCTION_FROZEN) return true; + if (!metafunction_compile(fn, err)) return false; + //metafunction_disassemble(fn); + fn->state=METAFUNCTION_FROZEN; + return true; +} + +/** Finalizes any metafunctions stored in a linked object list. */ +bool metafunction_finalizelist(object *list, error *err) { + for (object *obj=list; obj!=NULL; obj=obj->next) { + if (obj->type==OBJECT_METAFUNCTION && + !metafunction_finalize((objectmetafunction *) obj, err)) { + return false; + } + } + + return true; +} + signature *metafunction_getsignature(value fn) { if (MORPHO_ISFUNCTION(fn)) { return &MORPHO_GETFUNCTION(fn)->sig; @@ -177,7 +225,7 @@ signature *metafunction_getsignature(value fn) { return NULL; } -value _getname(value fn) { +value metafunction_getname(value fn) { if (MORPHO_ISFUNCTION(fn)) { return MORPHO_GETFUNCTION(fn)->name; } else if (MORPHO_ISBUILTINFUNCTION(fn)) { @@ -189,713 +237,1163 @@ value _getname(value fn) { } /* ********************************************************************** - * Fast metafunction resolver + * Metafunction base-case resolver * ********************************************************************** */ -DEFINE_VARRAY(mfinstruction, mfinstruction); - -#define MFINSTRUCTION_EMPTY -1 +/** Define a possible resolution */ +typedef struct { + value fn; + signature *sig; +} mfresolution; + +/** Checks if a resolution matches a given number of arguments */ +bool mfresolution_checkarity(mfresolution *res, int nargs) { + if (!res->sig) return false; + int nparams = signature_countparams(res->sig); + return (nparams == nargs) || (nargs >= nparams - 1 && signature_isvarg(res->sig)); +} -#define MFINSTRUCTION_FAIL { .opcode=MF_FAIL, .branch=MFINSTRUCTION_EMPTY } -#define MFINSTRUCTION_RESOLVE(fn) { .opcode=MF_RESOLVE, .data.resolvefn=fn, .branch=MFINSTRUCTION_EMPTY } -#define MFINSTRUCTION_OPTARGS { .opcode=MF_OPTARGS, .branch=MFINSTRUCTION_EMPTY } -#define MFINSTRUCTION_CHECKNARGS(op, n, brnch) { .opcode=op, .narg=n, .branch=brnch } -#define MFINSTRUCTION_CHECKTYPE(op, n, t, brnch) { .opcode=op, .data.tindx=t, .narg=n, .branch=brnch } -#define MFINSTRUCTION_BRANCH(brnch) { .opcode=MF_BRANCH, .branch=brnch } -#define MFINSTRUCTION_BRANCHNARG(table, brnch) { .opcode=MF_BRANCHNARGS, .data.btable=table, .branch=brnch } -#define MFINSTRUCTION_BRANCHTABLE(op, n, table, brnch) { .opcode=op, .narg=n, .data.btable=table, .branch=brnch } +/** Checks if a resolution matches a given set of arguments based on types */ +bool mfresolution_checktypes(mfresolution *res, int nargs, value *args) { + if (!res->sig) return false; + int nparams = signature_countparams(res->sig); -typedef struct { - signature *sig; /** Signature of the target */ - value fn; /** The target */ - int indx; /** Used to sort */ -} mfresult; + for (int i=0; isig->types.data[i])) return false; + } + + return true; +} -typedef struct { - int count; - mfresult *rlist; -} mfset; +/** Rank a parameter type by its distance from an actual argument type. */ +static bool mfresolution_rankparamtype(value actual, value type, int *out) { + if (MORPHO_ISEQUAL(actual, type)) { *out=0; return true; } + if (MORPHO_ISNIL(type)) { *out=INT_MAX; return true; } // Ensures a wildcare loses to an actual type -/** Static intiializer for the mfset */ -#define MFSET(c, l) { .count=c, .rlist=l } + if (MORPHO_ISCLASS(actual) && MORPHO_ISCLASS(type)) { + if (class_comparedistance(MORPHO_GETCLASS(actual), MORPHO_GETCLASS(type), out)) { + *out = abs(*out); return true; + } + } -DECLARE_VARRAY(mfset, mfset) -DEFINE_VARRAY(mfset, mfset) + return false; +} -typedef struct { - objectmetafunction *fn; - varray_int checked; // Stack of checked parameters - error err; -} mfcompiler; +/** Compare the specificity of two parameter types relative to an actual argument type. + * @returns true if the types are comparable, setting out to the signed comparison. */ +static bool mfresolution_compareparamtypes(value actual, value a, value b, int *out) { + int arank, brank; + if (mfresolution_rankparamtype(actual, a, &arank) && + mfresolution_rankparamtype(actual, b, &brank)) { + *out = arank-brank; + return true; + } + return false; +} -/** Initialize the metafunction compiler */ -void mfcompiler_init(mfcompiler *c, objectmetafunction *fn) { - c->fn=fn; - varray_intinit(&c->checked); - error_init(&c->err); +/** Compare resolutions by whether they are variadic. Non-variadic resolutions are more specific. */ +static int mfresolution_comparevarg(mfresolution *a, mfresolution *b) { + bool avarg = signature_isvarg(a->sig); + bool bvarg = signature_isvarg(b->sig); + if (avarg==bvarg) return 0; + return (avarg ? 1 : -1); } -/** Clear the metafunction compiler */ -void mfcompiler_clear(mfcompiler *c, objectmetafunction *fn) { - varray_intclear(&c->checked); - error_clear(&c->err); +/** Determine how many parameters should be checked when comparing resolutions. */ +static int _min(int a, int b, int c) { + return (a < b) ? ((a < c) ? a : c) : ((b < c) ? b : c); } -/** Report an error during metafunction compilation */ -void mfcompiler_error(mfcompiler *c, errorid id) { - morpho_writeerrorwithid(&c->err, id, NULL, ERROR_POSNUNIDENTIFIABLE, ERROR_POSNUNIDENTIFIABLE); +/** Returns the sign of an integer. */ +static int _sign(int x) { + return (x>0) - (x<0); } -/** Pushes a parameter check onto the stack*/ -void mfcompiler_pushcheck(mfcompiler *c, int i) { - varray_intwrite(&c->checked, i); +/** Check whether known argument types fully determine a signature. */ +static bool mfresolution_isterminal(signature *sig, int nargs, value *args); + +/** Compare the specificity of two resolutions. + * Returns <0 if a is more specific, >0 if b is more specific, 0 if they are equal + * or incomparable. */ +static int mfresolution_comparespecificity(mfresolution *a, mfresolution *b, int nargs, value *args) { + if (!a->sig || !b->sig) return 0; + if (!mfresolution_isterminal(a->sig, nargs, args) || + !mfresolution_isterminal(b->sig, nargs, args)) return 0; + + int ncheck=_min(signature_countparams(a->sig), signature_countparams(b->sig), nargs); + int cmp[ncheck]; + for (int i=0; isig->types.data[i], b->sig->types.data[i], &cmp[i]); + } + } + + int firstsign = 0; + for (int i=0; ichecked.count--; - return c->checked.data[c->checked.count]; +/** A set of possible resolutions */ +typedef struct { + int count; + mfresolution *data; +} mfresolutionset; + +/** @brief Collapses a set, removing any resolutions that lack a signature */ +void mfresolutionset_collapse(mfresolutionset *set) { + int n=0; + + for (int i=0; icount; i++) { + if (set->data[i].sig) { + set->data[n] = set->data[i]; + n++; + } + } + + set->count=n; } -/** Tests if a parameter has been checked according to the check stack */ -bool mfcompiler_ischecked(mfcompiler *c, int i) { - for (int j=0; jchecked.count; j++) if (i==c->checked.data[j]) return true; - return false; +/** @brief Initialize the set of resolutions from the metafunction. */ +void mfresolutionset_init(mfresolutionset *set, mfresolution *res, objectmetafunction *fn) { + set->count = fn->fns.count; + set->data=res; + for (int i=0; icount; i++) { + res[i].fn = fn->fns.data[i]; + res[i].sig = metafunction_getsignature(res[i].fn); + } + mfresolutionset_collapse(set); } -void _mfcompiler_disassemblebranchtable(mfinstruction *instr, mfindx i) { - for (int k=0; kdata.btable.count; k++) { - printf(" %i -> %i\n", k, i+instr->data.btable.data[k]+1); +/** @brief Filter the resolution set by arity */ +void mfresolutionset_filterbyarity(mfresolutionset *set, int nargs) { + for (int i=0; icount; i++) { + if (!mfresolution_checkarity(&set->data[i], nargs)) set->data[i].sig = NULL; } + mfresolutionset_collapse(set); } -/** Disassemble */ -void mfcompiler_disassemble(mfcompiler *c) { - int ninstr = c->fn->resolver.count; - morpho_printvalue(NULL, MORPHO_OBJECT(c->fn)); - printf(":\n"); - for (int i=0; ifn->resolver.data[i]; - printf("%5i : ", i) ; - switch(instr->opcode) { - case MF_CHECKNARGSNEQ: { - printf("checknargsneq %i -> (%i)", instr->narg, i+instr->branch+1); - break; - } - case MF_CHECKNARGSLT: { - printf("checknargslt %i -> (%i)", instr->narg, i+instr->branch+1); - break; - } - case MF_CHECKVALUE: { - objectclass *klass=value_veneerclassfromtype(instr->data.tindx); - printf("checkvalue (%i) [%s] -> (%i)", instr->narg, MORPHO_GETCSTRING(klass->name), i+instr->branch+1); - break; - } - case MF_CHECKOBJECT: { - objectclass *klass=object_getveneerclass(instr->data.tindx); - printf("checkobject (%i) [%s] -> (%i)", instr->narg, MORPHO_GETCSTRING(klass->name), i+instr->branch+1); - break; - } - case MF_CHECKINSTANCE: { - printf("checkinstance (%i) [%i] -> (%i)", instr->narg, instr->data.tindx, i+instr->branch+1); - break; - } - case MF_BRANCH: { - printf("branch -> (%i)", i+instr->branch+1); - break; - } - case MF_BRANCHNARGS: { - printf("branchnargs (%i) -> (%i)\n", instr->narg, i+instr->branch+1); - _mfcompiler_disassemblebranchtable(instr, i); - break; - } - case MF_BRANCHVALUETYPE: { - printf("branchvalue (%i) -> (%i)\n", instr->narg, i+instr->branch+1); - for (int k=0; kdata.btable.count; k++) { - if (instr->data.btable.data[k]==0) continue; - objectclass *klass=value_veneerclassfromtype(k); - printf(" %i [%s] -> %i\n", k, (klass ? MORPHO_GETCSTRING(klass->name) : ""), i+instr->data.btable.data[k]+1); - } - break; - } - case MF_BRANCHOBJECTTYPE: { - printf("branchobjtype (%i) -> (%i)\n", instr->narg, i+instr->branch+1); - for (int k=0; kdata.btable.count; k++) { - if (instr->data.btable.data[k]==0) continue; - objectclass *klass=object_getveneerclass(k); - printf(" %i [%s] -> %i\n", k, (klass ? MORPHO_GETCSTRING(klass->name) : ""), i+instr->data.btable.data[k]+1); - } - break; - } - case MF_BRANCHINSTANCE: { - printf("branchinstance (%i) -> (%i)\n", instr->narg, i+instr->branch+1); - _mfcompiler_disassemblebranchtable(instr, i); - break; - } - case MF_RESOLVE: { - printf("resolve "); - signature *sig = metafunction_getsignature(instr->data.resolvefn); - printf(" "); - if (sig) signature_print(sig); +/** @brief Filter the resolution set by types of the arguments */ +void mfresolutionset_filterbytypes(mfresolutionset *set, int nargs, value *args) { + for (int i=0; icount; i++) { + if (!mfresolution_checktypes(&set->data[i], nargs, args)) set->data[i].sig = NULL; + } + mfresolutionset_collapse(set); +} + +/** @brief Filter the resolution set by known argument types. */ +void mfresolutionset_filterbyknowntypes(mfresolutionset *set, int nargs, value *args) { + for (int i=0; icount; i++) { + if (!set->data[i].sig) continue; + for (int j=0; jdata[i].sig, j, &type) || + !mfresolution_rankparamtype(actual, type, &(int) { 0 })) { + set->data[i].sig = NULL; break; } - case MF_FAIL: printf("fail"); break; } - printf("\n"); } + mfresolutionset_collapse(set); } -/** Counts the range of parameters for the function call */ -void mfcompile_countparams(mfcompiler *c, mfset *set, int *min, int *max) { - int imin=INT_MAX, imax=INT_MIN; - for (int i=0; icount; i++) { - int nparams; - signature_paramlist(set->rlist[i].sig, &nparams, NULL); - if (nparamsimax) imax=nparams; +/** @brief Check whether known argument types fully determine a signature. */ +static bool mfresolution_isterminal(signature *sig, int nargs, value *args) { + int nparams = signature_countparams(sig); + + for (int i=0; icount; k++) { // Loop over outcomes - value type; - if (!signature_getparamtype(set->rlist[k].sig, i, &type)) continue; - if (!dictionary_insert(out, (MORPHO_ISNIL(type) ? MORPHO_FALSE : type), MORPHO_NIL)) return false; +/** @brief Filter the resolution set to maximal resolutions by specificity. */ +void mfresolutionset_filterbyspecificity(mfresolutionset *set, int nargs, value *args) { + for (int i=0; icount; i++) { // Compare all possible pairs and remove resolutions dominated by at least one other candidate + if (!set->data[i].sig) continue; + for (int j=i+1; jcount; j++) { + if (!set->data[j].sig) continue; + int cmp = mfresolution_comparespecificity(&set->data[i], &set->data[j], nargs, args); + if (cmp < 0) set->data[j].sig = NULL; + else if (cmp > 0) { set->data[i].sig = NULL; break; } + } } - return true; + mfresolutionset_collapse(set); } -/** Find the parameter number that has most variety in types */ -bool mfcompile_countoutcomes(mfcompiler *c, mfset *set, int *best) { - varray_int count; - varray_intinit(&count); - - dictionary dict; - dictionary_init(&dict); - - // Loop over parameters, counting the number of outcomes. - while (true) { - mfcompile_outcomes(c, set, count.count, &dict); - if (!dict.count) break; - varray_intwrite(&count, dict.count); - dictionary_clear(&dict); // Not needed if dict.count was zero - }; - - // Find the parameter that has most variability that has not already been checked - int max=0, maxindx=-1; - for (int i=0; imax) { max=count.data[i]; maxindx=i; } +/** @brief Find a resolution, if any exists, for given arguments by direct comparison. + @details Slow direct comparison acts as a source of truth for metafunction compiler. + @param[in] fn - the metafunction to resolve + @param[in] nargs - number of positional arguments + @param[in] args - positional arguments @warning: the first user-visible argument should be in the zero position + @param[out] err - error block to be filled out + @param[out] out - resolved function + @returns true if the metafunction was successfully resolved */ +static bool metafunction_resolveslow(objectmetafunction *fn, int nargs, value *args, error *err, value *out) { + if (fn->state!=METAFUNCTION_FROZEN) { + if (err) error_writewithid(err, METAFUNCTION_UNFROZEN); return false; } + + int nres = fn->fns.count; - varray_intclear(&count); + mfresolutionset set; // Initial set of resolutions + mfresolution res[nres]; - if (maxindx<0) return false; - if (best) *best = maxindx; + mfresolutionset_init(&set, res, fn); + mfresolutionset_filterbyarity(&set, nargs); + mfresolutionset_filterbytypes(&set, nargs, args); + mfresolutionset_filterbyspecificity(&set, nargs, args); + + switch (set.count) { + case 0: if (err) error_writewithid(err, VM_MLTPLDSPTCHFLD); return false; + case 1: if (out) *out = set.data[0].fn; return true; + default: if (err) error_writewithid(err, METAFUNCTION_CMPLAMBGS); return false; + } +} + +/* ********************************************************************** + * Fast metafunction resolver + * ********************************************************************** */ + +DEFINE_VARRAY(mfinstruction, mfinstruction); + +/** Bytecodes */ +enum { + MFOP_SLOW, + MFOP_RESOLVE, + MFOP_FAIL, + MFOP_GETUID, + MFOP_SPARSE +}; + +/* -------------------------- + * Fast resolver Compiler + * -------------------------- */ + +/** Candidate metadata used by the metafunction compiler. */ +typedef struct { + int fnindex; + signature *sig; + int nparams; + int minarity; + int maxarity; + bool varg; + bool typed; +} mfcompileresolution; + +/** Compiler state for building a metafunction resolver. */ +typedef struct { + objectmetafunction *fn; + error *err; + mfcompileresolution *resolutions; + int nresolutions; +} mfcompiler; + +/** Path-local facts accumulated while compiling one resolver branch. */ +typedef struct { + int knownarity; + bool aritychecked; + int nparams; + value *known; +} mfcompilerpath; + +/** Initialize compiler state. */ +static void mfcompiler_init(mfcompiler *compiler, objectmetafunction *fn, error *err) { + compiler->fn = fn; + compiler->err = err; + compiler->nresolutions = fn->fns.count; + compiler->resolutions = malloc(sizeof(mfcompileresolution)*compiler->nresolutions); +} + +/** Clear compiler state. */ +static void mfcompiler_clear(mfcompiler *compiler) { + if (compiler->resolutions) free(compiler->resolutions); + compiler->resolutions = NULL; + compiler->nresolutions = 0; +} + +/** Write a compiler error. */ +static void mfcompiler_error(mfcompiler *compiler, errorid id) { + if (compiler->err) error_writewithid(compiler->err, id); +} + +/** Analyze one candidate resolution. */ +static bool mfcompiler_analyzecandidate(mfcompiler *compiler, int i) { + ERR_CHECK_RETURN(compiler->resolutions); + + value fn = compiler->fn->fns.data[i]; + signature *sig = metafunction_getsignature(fn); + ERR_CHECK_RETURN(sig); + + mfcompileresolution *resolution = &compiler->resolutions[i]; + resolution->fnindex = i; + resolution->sig = sig; + resolution->nparams = signature_countparams(sig); + resolution->varg = signature_isvarg(sig); + resolution->typed = signature_istyped(sig); + resolution->minarity = (resolution->varg ? resolution->nparams-1 : resolution->nparams); + resolution->maxarity = (resolution->varg ? -1 : resolution->nparams); return true; } -mfindx mfcompile_insertinstruction(mfcompiler *c, mfinstruction instr) { - return varray_mfinstructionwrite(&c->fn->resolver, instr); +/** Analyze the candidate set for a metafunction. */ +static bool mfcompiler_analyze(mfcompiler *compiler) { + for (int i=0; inresolutions; i++) { + ERR_CHECK_RETURN(mfcompiler_analyzecandidate(compiler, i)); + } + return true; } -mfindx mfcompile_currentinstruction(mfcompiler *c) { - return c->fn->resolver.count-1; +/** Check for duplicate implementations that are unavoidably ambiguous. */ +static bool mfcompiler_checkduplicates(mfcompiler *compiler) { + for (int i=0; inresolutions; i++) { + for (int j=i+1; jnresolutions; j++) { + if (compiler->resolutions[i].varg==compiler->resolutions[j].varg && + signature_isequal(compiler->resolutions[i].sig, compiler->resolutions[j].sig)) { + mfcompiler_error(compiler, METAFUNCTION_CMPLAMBGS); + return false; + } + } + } + return true; } -mfindx mfcompile_nextinstruction(mfcompiler *c) { - return c->fn->resolver.count; +/** Emit one instruction into the resolver. */ +static bool mfcompiler_emit(mfcompiler *compiler, mfinstruction instruction, mfindx *entry) { + if (entry) *entry = compiler->fn->resolver.count; + return varray_mfinstructionadd(&compiler->fn->resolver, &instruction, 1); } -void mfcompile_setbranch(mfcompiler *c, mfindx i, mfindx branch) { - if (i>=c->fn->resolver.count) return; - c->fn->resolver.data[i].branch=branch; +/** Emit multiple instructions into the resolver. */ +static bool mfcompiler_emitmulti(mfcompiler *compiler, int n, mfinstruction *instructions, mfindx *entry) { + if (entry) *entry = compiler->fn->resolver.count; + return varray_mfinstructionadd(&compiler->fn->resolver, instructions, n); } -void mfcompile_replaceinstruction(mfcompiler *c, mfindx i, mfinstruction instr) { - if (i>=c->fn->resolver.count) return; - c->fn->resolver.data[i] = instr; +/** Emit a resolver block that falls back to the slow path. */ +static bool mfcompiler_emitslow(mfcompiler *compiler, mfindx *entry) { + return mfcompiler_emit(compiler, MFOP_SLOW, entry); } -enum { - MF_VENEERVALUE, - MF_INSTANCE, - MF_VENEEROBJECT, - MF_ANY -}; +/** Emit a resolver block that fails dispatch. */ +static bool mfcompiler_emitfail(mfcompiler *compiler, mfindx *entry) { + return mfcompiler_emit(compiler, MFOP_FAIL, entry); +} -/** Detects the kind of type */ -int _detecttype(value type, int *tindx) { - if (MORPHO_ISCLASS(type)) { - objectclass *klass = MORPHO_GETCLASS(type); - if (object_veneerclasstotype(klass, tindx)) { - return MF_VENEEROBJECT; - } else if (value_veneerclasstotype(klass, tindx)) { - return MF_VENEERVALUE; - } else { - if (tindx) *tindx=klass->uid; - return MF_INSTANCE; - } +/** Emit a resolver block that loads the uid of a given argument. */ +static bool mfcompiler_emitgetuid(mfcompiler *compiler, int arg, mfindx *entry) { + mfinstruction instructions[2] = { MFOP_GETUID, arg }; + return mfcompiler_emitmulti(compiler, 2, instructions, entry); +} + +/** Emit a resolver block that resolves to a specific implementation. */ +static bool mfcompiler_emitresolve(mfcompiler *compiler, int fnindex, mfindx *entry) { + mfinstruction instructions[2] = { MFOP_RESOLVE, fnindex }; + return mfcompiler_emitmulti(compiler, 2, instructions, entry); +} + +/** One entry in a sparse branch table. */ +typedef struct { + int value; + mfindx target; +} mfcompilersparseentry; + +/** One emitted child subtree that can be reused by later sparse cases. */ +typedef struct { + int nsubset; + value *known; + mfcompileresolution *subset; + mfindx target; +} mfcompileremittedcase; + +/** Emit a sparse branch over a table of value/target matches. */ +static bool mfcompiler_emitsparse(mfcompiler *compiler, int ncases, mfcompilersparseentry *table, mfindx deflt, mfindx *entry) { + mfinstruction header[3] = { MFOP_SPARSE, ncases, deflt }; + ERR_CHECK_RETURN(mfcompiler_emitmulti(compiler, 3, header, entry)); + + for (int i=0; imax) max = resolutions[i].nparams; + } + return max; } -/** Checks a parameter i for type */ -mfindx mfcompile_check(mfcompiler *c, int i, value type) { - int tindx; - int opcode[MF_ANY] = { MF_CHECKVALUE, MF_CHECKINSTANCE, MF_CHECKOBJECT }; - int k=_detecttype(type, &tindx); - - if (k==MF_ANY) return MFINSTRUCTION_EMPTY; - - mfinstruction check = MFINSTRUCTION_CHECKTYPE(opcode[k], i, tindx, 0); - return mfcompile_insertinstruction(c, check); +/** Check if a resolution matches a known exact arity. */ +static bool mfcompiler_matcharity(mfcompileresolution *resolution, int arity) { + return (resolution->minarity<=arity && + (resolution->maxarity<0 || arity<=resolution->maxarity)); } -/** Compiles a single result */ -mfindx mfcompile_resolve(mfcompiler *c, mfresult *res) { - mfindx start = mfcompile_nextinstruction(c); - - // Check all arguments have been resolved - signature *sig = res->sig; - for (int i=0; itypes.count; i++) { - if (MORPHO_ISNIL(sig->types.data[i]) || - mfcompiler_ischecked(c, i)) continue; - - mfcompile_check(c, i, sig->types.data[i]); +/** Check if a resolution matches the known runtime classes on this path. */ +static bool mfcompiler_matchknown(mfcompileresolution *resolution, int nparams, value *known) { + for (int i=0; inparams; i++) { + value type = MORPHO_NIL; + if (MORPHO_ISNIL(known[i])) continue; + if (!signature_getparamtype(resolution->sig, i, &type)) return false; + if (!mfresolution_rankparamtype(known[i], type, &(int) { 0 })) return false; } - - mfindx end = mfcompile_nextinstruction(c); - - mfinstruction instr = MFINSTRUCTION_RESOLVE(res->fn); - mfcompile_insertinstruction(c, instr); - - if (start!=end) { - mfindx fail = mfcompile_fail(c); - for (mfindx i=start; icount && set->rlist[k].indx<0) k++; - - // Deal with each outcome - while (kcount) { - int indx=set->rlist[k].indx, n=0; - while (k+ncount && set->rlist[k+n].indx==indx) n++; - - mfset out = MFSET(n, &set->rlist[k]); - - // Set the branch point - btable->data[indx]=mfcompile_currentinstruction(c)-bindx; - mfcompile_set(c, &out); - - k+=n; +/** Check if any resolutions in a candidate set are variadic. */ +static bool mfcompiler_hasvargresolutions(int nresolutions, mfcompileresolution *resolutions) { + for (int i=0; i0 && wildcard) ? 1 : 0); + dictionary_clear(&dict); + return count; } -void _insertchildren(dictionary *dict, value v) { - if (!MORPHO_ISCLASS(v) || - dictionary_get(dict, v, NULL)) return; +/** Insert a class and all of its descendants into a dictionary. */ +static bool mfcompiler_insertchildren(dictionary *dict, value type) { + if (!MORPHO_ISCLASS(type) || dictionary_get(dict, type, NULL)) return true; - dictionary_insert(dict, v, MORPHO_NIL); // Insert the class - objectclass *klass = MORPHO_GETCLASS(v); // and its children - for (int i=0; ichildren.count; i++) _insertchildren(dict, klass->children.data[i]); + ERR_CHECK_RETURN(dictionary_insert(dict, type, MORPHO_NIL)); + objectclass *klass = MORPHO_GETCLASS(type); + for (int i=0; ichildren.count; i++) { + ERR_CHECK_RETURN(mfcompiler_insertchildren(dict, klass->children.data[i])); + } + + return true; } -bool _resolve(objectclass *klass, dictionary *types, value *out) { - for (int k=0; klinearization.count; k++) { - if (dictionary_get(types, klass->linearization.data[k], NULL)) { - *out = klass->linearization.data[k]; - return true; - } +/** Collect all runtime classes reachable from a parameter's declared types. */ +static bool mfcompiler_paramchildren(int nresolutions, mfcompileresolution *resolutions, + int param, dictionary *children) { + for (int i=0; i=0 && !mfcompiler_matcharity(&resolutions[i], knownarity)) continue; + if (!mfcompiler_matchknown(&resolutions[i], nparams, known)) continue; + out[count++] = resolutions[i]; } + + return count; +} + +/** Check if a resolution is fully determined on this path. */ +static bool mfcompiler_resolutionisterminal(mfcompileresolution *resolution, int nparams, value *known) { + for (int i=0; inparams; i++) { + value type = MORPHO_NIL; + if (!signature_getparamtype(resolution->sig, i, &type)) return false; + if (!MORPHO_ISNIL(type) && MORPHO_ISNIL(known[i])) return false; + } + + return true; +} + +/** Check for any remaining unchecked typed parameter. */ +static bool mfcompiler_haspendingtypes(int nresolutions, mfcompileresolution *resolutions, + int nparams, value *known) { + for (int i=0; i0) return true; + } + return false; } -int _maxindx(dictionary *dict) { - int indx=0, maxindx=0; - for (int i=0; icapacity; i++) { - _detecttype(dict->contents[i].key, &indx); - if (indx>maxindx) maxindx=indx; +/** Count distinct declared non-wildcard types for one parameter in a subset. */ +static int mfcompiler_countparamtypes(int nresolutions, mfcompileresolution *resolutions, int param) { + value seen[nresolutions]; + int count = 0; + + for (int i=0; iindx, bi = bb->indx; - if (aa->sig->varg) ai=-1; // Ensure vargs end up first - if (bb->sig->varg) bi=-1; - - return ai-bi; +/** Remove known runtime classes that no longer affect dispatch within a subset. */ +static void mfcompiler_pruneknown(int nresolutions, mfcompileresolution *resolutions, int nparams, value *known) { + for (int i=0; icount; k++) { - value type; - if (!signature_getparamtype(set->rlist[k].sig, i, &type)) UNREACHABLE("Incorrect parameter type"); - if (_detecttype(type, &set->rlist[k].indx)==otype) { - dictionary_insert(&types, type, MORPHO_NIL); - _insertchildren(&children, type); - } else set->rlist[k].indx=-1; // Exclude from the branch table +/** Compare two candidate subsets for structural equality. */ +static bool mfcompiler_samesubset(int nresolutions, mfcompileresolution *a, mfcompileresolution *b) { + for (int i=0; irlist, set->count, sizeof(mfresult), _mfresultsortfn); - - // Create the branch table - int maxindx=_maxindx(&children); - varray_int btable; - varray_intinit(&btable); - for (int i=0; i<=maxindx; i++) varray_intwrite(&btable, 0); - - // Insert the branch instruction - mfinstruction instr = MFINSTRUCTION_BRANCHTABLE(opcode, i, btable, 0); - mfindx bindx = mfcompile_insertinstruction(c, instr); - - // Fail if an object type isn't in the table - mfcompile_fail(c); - - // Compile the branch table - mfcompile_branchtable(c, set, bindx, &btable); - - // Fix branch table to include child classes - for (int i=0; inparams, b->nparams, nparams); + int firstsign = 0; + + for (int i=0; isig, i, &atype) || + !signature_getparamtype(b->sig, i, &btype)) return 0; + if (!mfresolution_compareparamtypes(known[i], atype, btype, &cmp)) return 0; + if (cmp!=0) { + if (firstsign==0) firstsign = _sign(cmp); + else if (firstsign!=_sign(cmp)) return 0; } } - - // Clear temporary data structures - dictionary_clear(&types); - dictionary_clear(&children); - - return bindx; + + if (firstsign!=0) return firstsign; + if (a->varg==b->varg) return 0; + return (a->varg ? 1 : -1); } -/** Branch table on object type */ -mfindx mfcompile_dispatchveneerobj(mfcompiler *c, mfset *set, int i) { - return mfcompile_dispatchtable(c, set, i, MF_VENEEROBJECT, MF_BRANCHOBJECTTYPE); +/** Resolve a subset directly if known path facts determine all typed parameters. */ +static bool mfcompiler_resolveknownsubset(int nresolutions, mfcompileresolution *resolutions, + int nparams, value *known, int *fnindex) { + for (int i=0; i0) { + alive[i] = false; + break; + } + } + } + } + + int winner = -1; + for (int i=0; i=0) return false; + winner = i; + } + } + + if (winner<0) return false; + *fnindex = resolutions[winner].fnindex; + return true; } -/** Branch table on value type */ -mfindx mfcompile_dispatchveneervalue(mfcompiler *c, mfset *set, int i) { - return mfcompile_dispatchtable(c, set, i, MF_VENEERVALUE, MF_BRANCHVALUETYPE); +/** Check if a surviving subset is worth recursing into. */ +static bool mfcompiler_subsetisuseful(int nresolutions, mfcompileresolution *resolutions, + int nparams, value *known) { + int winner; + + if (nresolutions<=0) return false; + if (nresolutions==1 && mfcompiler_resolutionisterminal(&resolutions[0], nparams, known)) return true; + if (mfcompiler_resolveknownsubset(nresolutions, resolutions, nparams, known, &winner)) return true; + return mfcompiler_haspendingtypes(nresolutions, resolutions, nparams, known); } -/** Branch table on instance type */ -mfindx mfcompile_dispatchinstance(mfcompiler *c, mfset *set, int i) { - return mfcompile_dispatchtable(c, set, i, MF_INSTANCE, MF_BRANCHINSTANCE); +/** Count useful runtime-class branches for a parameter. */ +static int mfcompiler_parambranchcount(int nresolutions, mfcompileresolution *resolutions, + int knownarity, int nparams, value *known, int param) { + int useful = 0; + if (mfcompiler_paramisknown(known, param)) return 0; + + value childknown[nparams]; + mfcompileresolution subset[nresolutions]; + dictionary children; + dictionary_init(&children); + ERR_CHECK(mfcompiler_paramchildren(nresolutions, resolutions, param, &children), mfcompiler_parambranchcount_cleanup); + + for (unsigned int i=0; i0 && (countcount]; - int n=0; - - // Find implementations that accept any type - for (int k=0; kcount; k++) { - value type; - if (!signature_getparamtype(set->rlist[k].sig, i, &type)) return MFINSTRUCTION_EMPTY; - if (_detecttype(type, &set->rlist[k].indx)==MF_ANY) { - rlist[n] = set->rlist[k]; n++; +/** Choose a typed parameter to branch on. */ +static bool mfcompiler_choosetypeparam(int nresolutions, mfcompileresolution *resolutions, + int knownarity, int nparams, value *known, int *param) { + int bestparam = -1, bestuseful = 0, bestcount = 0; + + for (int i=0; ibestuseful || (useful==bestuseful && count>bestcount)) { + bestuseful = useful; + bestcount = count; + bestparam = i; } } - - mfindx bindx = mfcompile_nextinstruction(c); - - mfset anyset = MFSET(n, rlist); - mfcompile_set(c, &anyset); - - return bindx; + + *param = bestparam; + return (bestparam>=0 && bestuseful>0); +} + +static bool mfcompiler_emitresolver(mfcompiler *compiler, int nresolutions, mfcompileresolution *resolutions, mfcompilerpath *path, mfindx *entry); + +/** Compile the resolver entry point. */ +static bool mfcompiler_compileentry(mfcompiler *compiler, mfindx *entry) { + int nparams = mfcompiler_maxparams(compiler->nresolutions, compiler->resolutions); + if (nparams<1) nparams = 1; + + value known[nparams]; + for (int i=0; inresolutions, compiler->resolutions, &path, entry); } -/** Fixes a fallthrough fail */ -void mfcompile_fixfallthrough(mfcompiler *c, mfindx i, mfindx branchto) { - mfinstruction instr = MFINSTRUCTION_BRANCH(branchto-i-1); - mfcompile_replaceinstruction(c, i, instr); +/** Compare resolutions by arity for sorting. */ +static int mfcompiler_compareresolutionarity(const void *a, const void *b) { + int xi=((mfcompileresolution *) a)->nparams, yi=((mfcompileresolution *) b)->nparams; + return (xi > yi) - (xi < yi); // Ascending order } -typedef mfindx (mfcompile_dispatchfn) (mfcompiler *c, mfset *set, int i); +/** Emit an exact-arity case if a unique winner is already fully determined. */ +static bool mfcompiler_emitfixedaritywinner(mfcompiler *compiler, int nresolutions, mfcompileresolution *resolutions, int nparams, value *known, mfindx *entry) { + int winner = -1; -/** Attempts to dispatch based on a parameter i */ -mfindx mfcompile_dispatchonparam(mfcompiler *c, mfset *set, int i) { - mfcompiler_pushcheck(c, i); - int typecount[MF_ANY+1] = { 0, 0, 0, 0}; - - // Determine what types are present - for (int k=0; kcount; k++) { - value type; - if (!signature_getparamtype(set->rlist[k].sig, i, &type)) continue; - typecount[_detecttype(type, NULL)]++; + for (int i=0; i=0) return false; + winner = i; } - - mfindx bindx[MF_ANY+1]; - mfcompile_dispatchfn *dfn[MF_ANY+1] = { mfcompile_dispatchveneervalue, - mfcompile_dispatchinstance, - mfcompile_dispatchveneerobj, - mfcompile_dispatchany}; - - // Cycle through all value types, building a chain of branchtables - int n=0; - for (int j=0; j<=MF_ANY; j++) { - if (typecount[j] && dfn[j]) { - bindx[n]=(dfn[j]) (c, set, i); - if (n>0) mfcompile_setbranch(c, bindx[n-1], bindx[n]-bindx[n-1]-1); - n++; - } + + if (winner<0) { + if (nresolutions!=1) return false; + winner = 0; } - - if (typecount[MF_ANY]) { // Fix branch table fallthroughs to point to any - for (int j=0; jsig) ? MF_CHECKNARGSLT : MF_CHECKNARGSNEQ ), signature_countparams(res->sig), 0); - mfindx bindx = mfcompile_insertinstruction(c, instr); // Write the check nargs instruction - - mfcompile_resolve(c, res); - - return bindx; +/** Emit typed child branches for one split parameter. */ +static bool mfcompiler_emitchildcases(mfcompiler *compiler, int nresolutions, mfcompileresolution *resolutions, mfcompilerpath *path, int param, dictionary *children, mfcompilersparseentry *table, int *ncases) { + value childknown[children->count][path->nparams]; + value canonknown[children->count][path->nparams]; + mfcompileresolution subset[nresolutions]; + mfcompileremittedcase emitted[children->count]; + mfcompileresolution emittedsubset[children->count][nresolutions]; + int count = 0, nemitted = 0; + + for (unsigned int i=0; icapacity; i++) { + value actual = children->contents[i].key; + if (MORPHO_ISNIL(actual)) continue; + + value *known = childknown[count]; + value *canon = canonknown[count]; + mfcompilerpath childpath = *path; + childpath.known = known; + + int nsubset = mfcompiler_collectchildsubset(nresolutions, resolutions, path->knownarity, path->nparams, + path->known, known, param, actual, subset, canon); + if (nsubset<=0) continue; + + table[count].value = MORPHO_GETCLASS(actual)->uid; + + int match = mfcompiler_findemittedcase(nemitted, emitted, nsubset, subset, path->nparams, canon); + if (match>=0) { + table[count].target = emitted[match].target; + } else { + ERR_CHECK_RETURN(mfcompiler_emitresolver(compiler, nsubset, subset, &childpath, &table[count].target)); + memcpy(emittedsubset[nemitted], subset, sizeof(mfcompileresolution)*nsubset); + emitted[nemitted].nsubset = nsubset; + emitted[nemitted].known = canon; + emitted[nemitted].subset = emittedsubset[nemitted]; + emitted[nemitted].target = table[count].target; + nemitted++; + } + + count++; + } + + *ncases = count; + return true; } -/** Attempts to dispatch based on the number of arguments */ -mfindx mfcompile_dispatchonnarg(mfcompiler *c, mfset *set, int min, int max) { - mfindx bindx = MFINSTRUCTION_EMPTY; - - // Sort the set into order given by number of parameters; resolution with varg is always first - for (int k=0; kcount; k++) { - set->rlist[k].indx=signature_countparams(set->rlist[k].sig); +/** Emit a typed resolver for one exact-arity candidate set. */ +static bool mfcompiler_emittypedresolver(mfcompiler *compiler, int nresolutions, mfcompileresolution *resolutions, mfcompilerpath *path, mfindx *entry) { + int param, defaultcount, ncases; + dictionary children; + mfcompileresolution defaultsubset[nresolutions]; + mfindx deflt; + + dictionary_init(&children); + + ERR_CHECK(mfcompiler_choosetypeparam(nresolutions, resolutions, path->knownarity, path->nparams, path->known, ¶m), mfcompiler_emittypedresolver_cleanup); + ERR_CHECK(mfcompiler_paramchildren(nresolutions, resolutions, param, &children), mfcompiler_emittypedresolver_cleanup); + + { + /* Branch count is bounded by reachable runtime classes, not declared resolutions. */ + mfcompilersparseentry table[children.count]; + + ERR_CHECK(mfcompiler_defaultsubset(nresolutions, resolutions, param, defaultsubset, &defaultcount), mfcompiler_emittypedresolver_cleanup); + if (defaultcount>0) { + ERR_CHECK(mfcompiler_emitresolver(compiler, defaultcount, defaultsubset, path, &deflt), mfcompiler_emittypedresolver_cleanup); + } else ERR_CHECK(mfcompiler_emitslow(compiler, &deflt), mfcompiler_emittypedresolver_cleanup); + + ERR_CHECK(mfcompiler_emitchildcases(compiler, nresolutions, resolutions, path, + param, &children, table, &ncases), mfcompiler_emittypedresolver_cleanup); + if (ncases<=0) goto mfcompiler_emittypedresolver_cleanup; + ERR_CHECK(mfcompiler_emitgetuid(compiler, param, entry), mfcompiler_emittypedresolver_cleanup); + ERR_CHECK(mfcompiler_emitsparse(compiler, ncases, table, deflt, NULL), mfcompiler_emittypedresolver_cleanup); } - qsort(set->rlist, set->count, sizeof(mfresult), _mfresultsortfn); - - if (set->count==2) { - for (int i=1; i>=0; i--) { - bindx = mfcompile_checknarg(c, &set->rlist[i]); - - mfindx eindx = mfcompile_currentinstruction(c); - mfcompile_setbranch(c, bindx, eindx-bindx); + + dictionary_clear(&children); + return true; + +mfcompiler_emittypedresolver_cleanup: + dictionary_clear(&children); + return false; +} + +/** Emit an arity-first resolver for a candidate set. */ +static bool mfcompiler_emitarityresolver(mfcompiler *compiler, int nresolutions, mfcompileresolution *resolutions, mfcompilerpath *path, mfindx *entry) { + mfcompileresolution sorted[nresolutions]; + mfcompileresolution vargsubset[nresolutions]; + memcpy(sorted, resolutions, sizeof(mfcompileresolution)*nresolutions); + qsort(sorted, nresolutions, sizeof(mfcompileresolution), mfcompiler_compareresolutionarity); + + mfindx deflt; + int nvarg = 0; + for (int i=0; inparams, path->known)) { + vargsubset[nvarg++] = sorted[i]; } - mfcompile_fail(c); - } else { // If more than two options, generate a branch table - varray_int btable; - varray_intinit(&btable); - for (int i=0; i<=max; i++) varray_intwrite(&btable, 0); - - // Insert the branch table instruction - mfinstruction table = MFINSTRUCTION_BRANCHNARG(btable, 0); - bindx = mfcompile_insertinstruction(c, table); - - // Immediately follow by a fail instruction if this falls through - mfindx fail = mfcompile_fail(c); - - // Compile the branch table - mfcompile_branchtable(c, set, bindx, &btable); - - // Correct branch table for varg resolution - if (set->rlist[0].sig->varg) { - mfindx varg = bindx+1; - int nmin = set->rlist[0].sig->types.count-1; // varg can match this many args or more - for (int i=nmin; inparams, path->known)) { + bucket[count++] = sorted[j]; } - - mfcompile_setbranch(c, bindx, varg); // Correct branchargs branch destination to point to the varg resolution } + + table[ncases].value = arity; + mfcompilerpath bucketpath = *path; + bucketpath.knownarity = arity; + bucketpath.aritychecked = true; + ERR_CHECK_RETURN(mfcompiler_emitresolver(compiler, count, bucket, &bucketpath, &table[ncases].target)); + ncases++; } - return bindx; + + return mfcompiler_emitsparse(compiler, ncases, table, deflt, entry); } -/** Attempts to discriminate between a list of possible signatures */ -mfindx mfcompile_set(mfcompiler *c, mfset *set) { - if (set->count==1) return mfcompile_resolve(c, set->rlist); - - int min, max; // Count the range of possible parameters - mfcompile_countparams(c, set, &min, &max); - - // Dispatch on the number of parameters if it's in doubt - if (min!=max) return mfcompile_dispatchonnarg(c, set, min, max); - - // If just one parameter, dispatch on it - if (min==1 && !mfcompiler_ischecked(c, 0)) { - return mfcompile_dispatchonparam(c, set, 0); +/** Emit a resolver block for a filtered candidate set. */ +static bool mfcompiler_emitresolver(mfcompiler *compiler, int nresolutions, mfcompileresolution *resolutions, mfcompilerpath *path, mfindx *entry) { + mfcompilerpath exactpath; + + /* No candidates remain on this path. */ + if (nresolutions<=0) return mfcompiler_emitfail(compiler, entry); + + /* A single fully-determined resolution can be emitted directly. */ + if (nresolutions==1 && mfcompiler_resolutionisterminal(&resolutions[0], path->nparams, path->known)) { + return mfcompiler_emitresolve(compiler, resolutions[0].fnindex, entry); } - - int best; - if (mfcompile_countoutcomes(c, set, &best)) return mfcompile_dispatchonparam(c, set, best); - - mfcompiler_error(c, METAFUNCTION_CMPLAMBGS); - return MFINSTRUCTION_EMPTY; -} -/** Clears the compiled code from a given metafunction */ -void metafunction_clearinstructions(objectmetafunction *fn) { - for (int i=0; iresolver.count; i++) { - mfinstruction *mf = &fn->resolver.data[i]; - if (mf->opcode>=MF_BRANCHNARGS && mf->opcode<=MF_BRANCHINSTANCE) varray_intclear(&mf->data.btable); + bool hastyped = mfcompiler_hastypedresolutions(nresolutions, resolutions); + if (!path->aritychecked && + !mfcompiler_hasvargresolutions(nresolutions, resolutions) && + mfcompiler_countarities(nresolutions, resolutions)==1) { + exactpath = *path; + exactpath.knownarity = resolutions[0].nparams; + exactpath.aritychecked = true; + path = &exactpath; + + // Add a sparse to verify that nargs matches the known arity + mfindx deflt; + mfcompiler_emitfail(compiler, &deflt); + mfcompilersparseentry correctarity; + correctarity.value = path->knownarity; + ERR_CHECK_RETURN(mfcompiler_emitresolver(compiler, nresolutions, resolutions, path, &correctarity.target)); + return mfcompiler_emitsparse(compiler, 1, &correctarity, deflt, entry); } - varray_mfinstructionclear(&fn->resolver); + + /* For exact arity without typed params, emit the lone fixed-arity winner. */ + if (!hastyped && path->knownarity>=0) { + if (mfcompiler_emitfixedaritywinner(compiler, nresolutions, resolutions, path->nparams, path->known, entry)) return true; + } + + /* Known path facts may already determine the winner. */ + if (path->aritychecked) { + int fnindex; + if (mfcompiler_resolveknownsubset(nresolutions, resolutions, path->nparams, path->known, &fnindex)) { + return mfcompiler_emitresolve(compiler, fnindex, entry); + } + } + + /* Split by arity before considering typed dispatch. */ + if (!path->aritychecked && + (mfcompiler_countarities(nresolutions, resolutions)>1 || mfcompiler_hasvargresolutions(nresolutions, resolutions))) { + return mfcompiler_emitarityresolver(compiler, nresolutions, resolutions, path, entry); + } + + /* Otherwise try a typed split on the current arity-filtered subset. */ + if (hastyped) { + if (mfcompiler_emittypedresolver(compiler, nresolutions, resolutions, path, entry)) return true; + } + + /* Fall back to the runtime resolver when no fast split is worthwhile. */ + return mfcompiler_emitslow(compiler, entry); } -/** Compiles the metafunction resolver */ +/** Compile a resolver for a metafunction being assembled. */ bool metafunction_compile(objectmetafunction *fn, error *err) { - mfset set; - set.count = fn->fns.count; - if (!set.count) return false; - - mfresult rlist[set.count]; - set.rlist=rlist; - for (int i=0; ifns.data[i]); - rlist[i].fn=fn->fns.data[i]; - } - + if (fn->fns.count<=0) return false; + mfcompiler compiler; - mfcompiler_init(&compiler, fn); - - mfcompile_set(&compiler, &set); - //mfcompiler_disassemble(&compiler); + mfcompiler_init(&compiler, fn, err); + metafunction_clearinstructions(fn); + + ERR_CHECK(mfcompiler_analyze(&compiler), metafunction_compile_cleanup); + ERR_CHECK(mfcompiler_checkduplicates(&compiler), metafunction_compile_cleanup); + ERR_CHECK(mfcompiler_compileentry(&compiler, &fn->entry), metafunction_compile_cleanup); + mfcompiler_clear(&compiler); + return true; + +metafunction_compile_cleanup: + mfcompiler_clear(&compiler); + metafunction_clearinstructions(fn); + return false; +} + +/* -------------------------- + * Disassembler + * -------------------------- */ + +/** Disassemble a RESOLVE instruction. */ +static mfindx metafunction_disassembleresolve(objectmetafunction *fn, mfindx pc) { + if (pc+1>=fn->resolver.count) { printf("resolve "); return pc+1; } - bool success=!morpho_checkerror(&compiler.err); - if (!success && err) *err=compiler.err; + int index=fn->resolver.data[pc+1]; + printf("resolve %i ", index); + if (index<0 || index>=fn->fns.count) printf(""); + else { + signature *sig = metafunction_getsignature(fn->fns.data[index]); + if (sig) signature_print(sig); + } + return pc+2; +} + +/** Disassemble a SPARSE instruction. */ +static mfindx metafunction_disassemblesparse(objectmetafunction *fn, mfindx pc) { + if (pc+2>=fn->resolver.count) { printf("sparse "); return fn->resolver.count; } - mfcompiler_clear(&compiler, fn); + int ncases=fn->resolver.data[pc+1]; + mfindx defaultpc=fn->resolver.data[pc+2]; + printf("sparse default -> %i", defaultpc); - return success; + mfindx next=pc+3; + for (int k=0; k=fn->resolver.count) { printf(" "); return fn->resolver.count; } + printf(" %i -> %i", fn->resolver.data[next], fn->resolver.data[next+1]); + next+=2; + } + return next; } -/** Attempt to find the desired class uid in the linearization of a given class */ -bool _finduidinlinearization(objectclass *klass, int uid) { - for (int k=0; klinearization.count; k++) { - if (MORPHO_GETCLASS(klass->linearization.data[k])->uid == uid) return true; - } - return false; +/** Disassemble a GETUID instruction. */ +static mfindx metafunction_disassemblegetuid(objectmetafunction *fn, mfindx pc) { + if (pc+1>=fn->resolver.count) { printf("getuid "); return pc+1; } + printf("getuid %i", fn->resolver.data[pc+1]); + return pc+2; } -/** Execute the metafunction's resolver - @param[in] fn - the metafunction to resolve - @param[in] nargs - number of positional arguments - @param[in] args - positional arguments @warning: the first user-visible argument should be in the zero position - @param[out] err - error block to be filled out - @param[out] out - resolved function - @returns true if the metafunction was successfully resolved */ -bool metafunction_resolve(objectmetafunction *fn, int nargs, value *args, error *err, value *out) { - if (!fn->resolver.data && - !metafunction_compile(fn, err)) return false; - mfinstruction *pc = fn->resolver.data; - if (!pc) return false; - - do { - switch(pc->opcode) { - case MF_CHECKNARGSNEQ: - if (nargs!=pc->narg) pc+=pc->branch; - break; - case MF_CHECKNARGSLT: - if (nargsnarg) pc+=pc->branch; +/** Print a disassembly of the metafunction resolver bytecode. */ +void metafunction_disassemble(objectmetafunction *fn) { + printf("Resolver for "); + morpho_printvalue(NULL, MORPHO_OBJECT(fn)); + printf(":\n"); + + for (mfindx pc=0; pcresolver.count; ) { + printf("%s%3i : ", (pc==fn->entry ? "->" : " "), pc); + switch (fn->resolver.data[pc]) { + case MFOP_SLOW: printf("slow"); pc++; break; + case MFOP_FAIL: printf("fail"); pc++; break; + case MFOP_RESOLVE: pc=metafunction_disassembleresolve(fn, pc); break; + case MFOP_GETUID: pc=metafunction_disassemblegetuid(fn, pc); break; + case MFOP_SPARSE: pc=metafunction_disassemblesparse(fn, pc); break; + default: + printf("unknown %i", fn->resolver.data[pc]); + pc++; break; - case MF_CHECKVALUE: { - if (!MORPHO_ISOBJECT(args[pc->narg])) { - int tindx = (int) MORPHO_GETORDEREDTYPE(args[pc->narg]); - if (pc->data.tindx!=tindx) pc+=pc->branch; - } else pc+=pc->branch; + } + printf("\n"); + } +} + +/* -------------------------- + * Fast resolver VM + * -------------------------- */ + +/** Execute the new resolver VM. */ +static bool metafunction_runresolver(objectmetafunction *fn, int nargs, value *args, error *err, value *out) { + mfinstruction *instructions = fn->resolver.data; + if (!instructions) return metafunction_resolveslow(fn, nargs, args, err, out); + + mfindx pc = fn->entry; + int reg = nargs; // Single register initialized with nargs + + while (true) { + switch (instructions[pc]) { + case MFOP_SLOW: + return metafunction_resolveslow(fn, nargs, args, err, out); + case MFOP_RESOLVE: { + *out=fn->fns.data[instructions[++pc]]; + return true; } - break; - case MF_CHECKOBJECT: { - if (MORPHO_ISOBJECT(args[pc->narg])) { - int tindx = (int) MORPHO_GETOBJECTTYPE(args[pc->narg]); - if (pc->data.tindx!=tindx) pc+=pc->branch; - } else pc+=pc->branch; + case MFOP_FAIL: + error_writewithid(err, VM_MLTPLDSPTCHFLD); return false; + case MFOP_GETUID: { + int arg = instructions[++pc]; + value type; + if (value_type(args[arg], &type) && MORPHO_ISCLASS(type)) { + reg = MORPHO_GETCLASS(type)->uid; + break; + } + error_writewithid(err, VM_MLTPLDSPTCHFLD); return false; } - break; - case MF_CHECKINSTANCE: { - if (MORPHO_ISINSTANCE(args[pc->narg])) { - objectclass *klass = MORPHO_GETINSTANCE(args[pc->narg])->klass; - - if (!(klass->uid==pc->data.tindx || - _finduidinlinearization(klass, pc->data.tindx))) { - pc+=pc->branch; + case MFOP_SPARSE: { + int ncases=instructions[pc+1]; + mfindx cases=pc+3; + pc=instructions[pc+2]; // Default branch + for (int i=0; i<2*ncases; i+=2) { + if (instructions[cases+i]==reg) { // match + pc=instructions[cases+i+1]; + break; } - } else pc+=pc->branch; - } - break; - case MF_BRANCH: - pc+=pc->branch; - break; - case MF_BRANCHNARGS: - if (nargsdata.btable.count) { - pc+=pc->data.btable.data[nargs]; - } else pc+=pc->branch; - break; - case MF_BRANCHVALUETYPE: { - if (!MORPHO_ISOBJECT(args[pc->narg])) { - int type = (int) MORPHO_GETORDEREDTYPE(args[pc->narg]); - if (typedata.btable.count) pc+=pc->data.btable.data[type]; - } else pc+=pc->branch; - } - break; - case MF_BRANCHOBJECTTYPE: { - if (MORPHO_ISOBJECT(args[pc->narg])) { - int type = MORPHO_GETOBJECTTYPE(args[pc->narg]); - if (typedata.btable.count) pc+=pc->data.btable.data[type]; - } else pc+=pc->branch; - } - break; - case MF_BRANCHINSTANCE: { - if (MORPHO_ISINSTANCE(args[pc->narg])) { - // TODO: Check for btable bound - objectclass *klass = MORPHO_GETINSTANCE(args[pc->narg])->klass; - if (klass->uiddata.btable.count) pc+=pc->data.btable.data[klass->uid]; - } else pc+=pc->branch; + } + continue; } - break; - case MF_RESOLVE: - *out = pc->data.resolvefn; - return true; - case MF_FAIL: - return false; } pc++; - } while(true); + } +} + +/** Resolve a metafunction using the compiled resolver VM. */ +bool metafunction_resolve(objectmetafunction *fn, int nargs, value *args, error *err, value *out) { + if (fn->state!=METAFUNCTION_FROZEN) { + error_writewithid(err, METAFUNCTION_UNFROZEN); return false; + } + + return metafunction_runresolver(fn, nargs, args, err, out); +} + +/* ********************************************************************** + * Specialize a metafunction given type information + * ********************************************************************** */ + +/** Reduce a metafunction using known argument types. */ +bool metafunction_reduce(objectmetafunction *fn, int nargs, value *args, error *err, value *out) { + int nres = fn->fns.count; + mfresolutionset set; + mfresolution res[nres]; + objectmetafunction *reduced = NULL; + + mfresolutionset_init(&set, res, fn); + mfresolutionset_filterbyarity(&set, nargs); + mfresolutionset_filterbyknowntypes(&set, nargs, args); + mfresolutionset_filterbyspecificity(&set, nargs, args); + + if (set.count<=0) { // No resolutions left + error_writewithid(err, VM_MLTPLDSPTCHFLD); return false; + } else if (set.count==1 && + mfresolution_isterminal(set.data[0].sig, nargs, args)) { // Resolution is completely specified + *out = set.data[0].fn; return true; + } else if (set.count==fn->fns.count) { // Resolution set is unchanged + *out = MORPHO_OBJECT(fn); return true; + } + + ERR_CHECK(reduced = object_newmetafunction(fn->name), metafunction_reduce_cleanup); + + metafunction_setclass(reduced, metafunction_class(fn)); + for (int i=0; ifns.count); } +value Metafunction_tostring(vm *v, int nargs, value *args) { + objectmetafunction *func=MORPHO_GETMETAFUNCTION(MORPHO_SELF(args)); + value out = MORPHO_NIL; + + varray_char buffer; + varray_charinit(&buffer); + + varray_charadd(&buffer, "name, &buffer); + varray_charwrite(&buffer, '>'); + + out = object_stringfromvarraychar(&buffer); + if (MORPHO_ISSTRING(out)) { + morpho_bindobjects(v, 1, &out); + } + varray_charclear(&buffer); + + return out; +} + MORPHO_BEGINCLASS(Metafunction) -MORPHO_METHOD(MORPHO_COUNT_METHOD, Metafunction_count, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_TOSTRING_METHOD, Metafunction_tostring, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(MORPHO_COUNT_METHOD, Metafunction_count, MORPHO_FN_PUREFN) MORPHO_ENDCLASS /* ********************************************************************** @@ -947,12 +1466,8 @@ MORPHO_ENDCLASS objecttype objectmetafunctiontype; void metafunction_initialize(void) { - // Create function object type - objectmetafunctiontype=object_addtype(&objectmetafunctiondefn); - - // Locate the Object class to use as the parent class of Metafunction - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + // Locate the Callable class to use as the parent class of Metafunction + value objclass = builtin_findclassfromcstring(CALLABLE_CLASSNAME); // Metafunction constructor function morpho_addfunction(METAFUNCTION_CLASSNAME, METAFUNCTION_CLASSNAME " (...)", metafunction_constructor, MORPHO_FN_CONSTRUCTOR, NULL); @@ -963,4 +1478,5 @@ void metafunction_initialize(void) { // Metafunction error messages morpho_defineerror(METAFUNCTION_CMPLAMBGS, ERROR_PARSE, METAFUNCTION_CMPLAMBGS_MSG); + morpho_defineerror(METAFUNCTION_UNFROZEN, ERROR_HALT, METAFUNCTION_UNFROZEN_MSG); } diff --git a/src/classes/metafunction.h b/src/classes/metafunction.h index 678bf43a8..9e1a7196b 100644 --- a/src/classes/metafunction.h +++ b/src/classes/metafunction.h @@ -19,27 +19,26 @@ extern objecttype objectmetafunctiontype; /** Index type for metafunction resolver */ typedef int mfindx; -/** Compiled metafunction instruction set */ -typedef struct { - int opcode; - int narg; - union { - int tindx; - value resolvefn; - varray_int btable; - } data; - mfindx branch; /* Branch the pc by this amount on fail */ -} mfinstruction; +/** Compiled metafunction bytecode cell */ +typedef int mfinstruction; DECLARE_VARRAY(mfinstruction, mfinstruction); +/** Metafunction status */ +typedef enum { + METAFUNCTION_BUILDING, + METAFUNCTION_FROZEN +} metafunctionstate; + /** A metafunction object */ typedef struct sobjectmetafunction { object obj; value name; objectclass *klass; // Parent class for metafunction methods + metafunctionstate state; varray_value fns; varray_mfinstruction resolver; + mfindx entry; // Entry point for the resolver } objectmetafunction; /** Gets an objectmetafunction from a value */ @@ -61,6 +60,9 @@ typedef struct sobjectmetafunction { #define METAFUNCTION_CMPLAMBGS "MltplDisptchAmbg" #define METAFUNCTION_CMPLAMBGS_MSG "Ambiguous or duplicate implementations in multiple dispatch." +#define METAFUNCTION_UNFROZEN "MltplDisptchUnfrzn" +#define METAFUNCTION_UNFROZEN_MSG "Metafunction was used before it was finalized." + /* ------------------------------------------------------- * Metafunction interface * ------------------------------------------------------- */ @@ -69,8 +71,8 @@ objectmetafunction *object_newmetafunction(value name); objectmetafunction *metafunction_clone(objectmetafunction *f); bool metafunction_wrap(value name, value fn, value *out); +bool metafunction_merge(value name, value existing, value incoming, objectclass *klass, value *out); bool metafunction_add(objectmetafunction *f, value fn); -bool metafunction_typefromvalue(value v, value *out); void metafunction_setclass(objectmetafunction *f, objectclass *klass); objectclass *metafunction_class(objectmetafunction *f); @@ -79,10 +81,16 @@ bool metafunction_matchfn(objectmetafunction *fn, value f); bool metafunction_matchset(objectmetafunction *fn, int n, value *fns); signature *metafunction_getsignature(value fn); +void metafunction_inferreturntype(objectmetafunction *fn, value *type); + bool metafunction_compile(objectmetafunction *fn, error *err); +bool metafunction_finalize(objectmetafunction *fn, error *err); +bool metafunction_finalizelist(object *list, error *err); void metafunction_clearinstructions(objectmetafunction *fn); +void metafunction_disassemble(objectmetafunction *fn); bool metafunction_resolve(objectmetafunction *f, int nargs, value *args, error *err, value *fn); +bool metafunction_reduce(objectmetafunction *f, int nargs, value *args, error *err, value *out); void metafunction_initialize(void); diff --git a/src/classes/nil.c b/src/classes/nil.c new file mode 100644 index 000000000..8ebf67394 --- /dev/null +++ b/src/classes/nil.c @@ -0,0 +1,26 @@ +/** @file nil.c + * @author T J Atherton + * + * @brief Veneer class for float values + */ + +#include "morpho.h" +#include "classes.h" + +/* ********************************************************************** + * Float veneer class + * ********************************************************************** */ + +MORPHO_BEGINCLASS(Nil) +MORPHO_METHOD(MORPHO_CLASS_METHOD, Object_class, MORPHO_FN_PUREFN) +MORPHO_ENDCLASS + +/* ********************************************************************** + * Initialization and finalization + * ********************************************************************** */ + +void nil_initialize(void) { + // Create Nil veneer class + value nilclass=builtin_addclass(NIL_CLASSNAME, MORPHO_GETCLASSDEFINITION(Nil), MORPHO_NIL); + value_setveneerclass(MORPHO_NIL, nilclass); +} diff --git a/src/classes/nil.h b/src/classes/nil.h new file mode 100644 index 000000000..f59ad442b --- /dev/null +++ b/src/classes/nil.h @@ -0,0 +1,26 @@ +/** @file nil.h + * @author T J Atherton + * + * @brief Veneer class for nil values + */ + +#ifndef nil_h +#define nil_h + +/* ------------------------------------------------------- + * Nil veneer class + * ------------------------------------------------------- */ + +#define NIL_CLASSNAME "Nil" + +/* ------------------------------------------------------- + * Nil error messages + * ------------------------------------------------------- */ + +/* ------------------------------------------------------- + * Nil interface + * ------------------------------------------------------- */ + +void nil_initialize(void); + +#endif diff --git a/src/classes/range.c b/src/classes/range.c index f7ac9e1dd..53b0a4b42 100644 --- a/src/classes/range.c +++ b/src/classes/range.c @@ -159,30 +159,28 @@ value range_invldconstructor(vm *v, int nargs, value *args) { /** Gets a specified element from a range */ value Range_getindex(vm *v, int nargs, value *args) { objectrange *slf = MORPHO_GETRANGE(MORPHO_SELF(args)); - - if (nargs==1 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - - if (nnsteps) return range_iterate(slf, n); - else morpho_runtimeerror(v, VM_OUTOFBOUNDS); + int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + if (n<0 || n>=slf->nsteps) { + morpho_runtimeerror(v, VM_OUTOFBOUNDS); + return MORPHO_NIL; } - - return MORPHO_SELF(args); + + return range_iterate(slf, n); } /** Enumerate members of a range */ value Range_enumerate(vm *v, int nargs, value *args) { objectrange *slf = MORPHO_GETRANGE(MORPHO_SELF(args)); - value out=MORPHO_NIL; - - if (nargs==1 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - - if (n<0) return MORPHO_INTEGER(slf->nsteps); - else return range_iterate(slf, n); - } else MORPHO_RAISE(v, ENUMERATE_ARGS); - - return out; + int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + if (n<0) return MORPHO_INTEGER(slf->nsteps); + if (n>=slf->nsteps) { + morpho_runtimeerror(v, VM_OUTOFBOUNDS); + return MORPHO_NIL; + } + + return range_iterate(slf, n); } /** Count number of items in a range */ @@ -208,11 +206,11 @@ value Range_clone(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Range) -MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Range_getindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Range_enumerate, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_COUNT_METHOD, Range_count, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Range_clone, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, " (Int)", Range_getindex, MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_ENUMERATE_METHOD, " (Int)", Range_enumerate, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_COUNT_METHOD, "Int ()", Range_count, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_CLONE_METHOD, "Range ()", Range_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES) MORPHO_ENDCLASS /* ********************************************************************** @@ -226,8 +224,7 @@ void range_initialize(void) { objectrangetype=object_addtype(&objectrangedefn); // Locate the Object class to use as the parent class of Range - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); // Create range veneer class value rangeclass=builtin_addclass(RANGE_CLASSNAME, MORPHO_GETCLASSDEFINITION(Range), objclass); diff --git a/src/classes/strng.c b/src/classes/strng.c index e74282451..0bbd03d37 100644 --- a/src/classes/strng.c +++ b/src/classes/strng.c @@ -176,6 +176,7 @@ int string_countchars(objectstring *s) { /** Get a pointer to the i'th character of a string */ char *string_index(objectstring *s, int i) { + if (i<0) return NULL; int n=0; for (char *c = s->string; *c!='\0'; ) { if (i==n) return (char *) c; @@ -219,28 +220,44 @@ value String_clone(vm *v, int nargs, value *args) { return out; } -/** Enumerate members of a string */ -value String_enumerate(vm *v, int nargs, value *args) { +/** Gets a specified character from a string */ +value String_getindex(vm *v, int nargs, value *args) { objectstring *slf = MORPHO_GETSTRING(MORPHO_SELF(args)); value out=MORPHO_NIL; + int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - if (nargs==1 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + char *c = string_index(slf, n); + if (c) { + out=object_stringfromcstring(c, morpho_utf8numberofbytes(c)); + morpho_bindobjects(v, 1, &out); + } else morpho_runtimeerror(v, VM_OUTOFBOUNDS); + return out; +} - if (n<0) { - out=MORPHO_INTEGER(string_countchars(slf)); - } else { - char *c=string_index(slf, n); - if (c) { - out=object_stringfromcstring(c, morpho_utf8numberofbytes(c)); - morpho_bindobjects(v, 1, &out); - } else morpho_runtimeerror(v, VM_OUTOFBOUNDS); - } - } else MORPHO_RAISE(v, ENUMERATE_ARGS); +/** Enumerate members of a string */ +value String_enumerate(vm *v, int nargs, value *args) { + objectstring *slf = MORPHO_GETSTRING(MORPHO_SELF(args)); + value out=MORPHO_NIL; + int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + if (n<0) { + out=MORPHO_INTEGER(string_countchars(slf)); + } else { + char *c=string_index(slf, n); + if (c) { + out=object_stringfromcstring(c, morpho_utf8numberofbytes(c)); + morpho_bindobjects(v, 1, &out); + } else morpho_runtimeerror(v, VM_OUTOFBOUNDS); + } return out; } +value String_enumerate__err(vm *v, int nargs, value *args) { + MORPHO_RAISE(v, ENUMERATE_ARGS); + return MORPHO_NIL; +} + /** Tests if a string encodes a number */ value String_isnumber(vm *v, int nargs, value *args) { objectstring *slf = MORPHO_GETSTRING(MORPHO_SELF(args)); @@ -255,48 +272,75 @@ value String_isnumber(vm *v, int nargs, value *args) { value String_split(vm *v, int nargs, value *args) { objectstring *slf = MORPHO_GETSTRING(MORPHO_SELF(args)); value out=MORPHO_NIL; - - if (nargs==1 && MORPHO_ISSTRING(MORPHO_GETARG(args, 0))) { - objectstring *split = MORPHO_GETSTRING(MORPHO_GETARG(args, 0)); - objectlist *new = object_newlist(0, NULL); - - if (!new) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return MORPHO_NIL; } - - char *last = slf->string; - for (char *c = slf->string; *c!='\0'; c+=morpho_utf8numberofbytes(c)) { // Loop over string - for (char *s = split->string; *s!='\0';) { // Loop over split chars - int nbytes = morpho_utf8numberofbytes(s); - if (strncmp(c, s, nbytes)==0) { - value newstring = object_stringfromcstring(last, c-last); - if (MORPHO_ISNIL(newstring)) morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); - list_append(new, newstring); - last=c+nbytes; - } - s+=nbytes; + objectstring *split = MORPHO_GETSTRING(MORPHO_GETARG(args, 0)); + objectlist *new = object_newlist(0, NULL); + + if (!new) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return MORPHO_NIL; } + + char *last = slf->string; + for (char *c = slf->string; *c!='\0'; c+=morpho_utf8numberofbytes(c)) { // Loop over string + for (char *s = split->string; *s!='\0';) { // Loop over split chars + int nbytes = morpho_utf8numberofbytes(s); + if (strncmp(c, s, nbytes)==0) { + value newstring = object_stringfromcstring(last, c-last); + if (MORPHO_ISNIL(newstring)) morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + list_append(new, newstring); + last=c+nbytes; } + s+=nbytes; } + } - value newstring = object_stringfromcstring(last, slf->string+slf->length-last); - if (MORPHO_ISNIL(newstring)) morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); - list_append(new, newstring); + value newstring = object_stringfromcstring(last, slf->string+slf->length-last); + if (MORPHO_ISNIL(newstring)) morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + list_append(new, newstring); - out=MORPHO_OBJECT(new); - list_append(new, out); - morpho_bindobjects(v, new->val.count, new->val.data); - new->val.count-=1; + out=MORPHO_OBJECT(new); + list_append(new, out); + morpho_bindobjects(v, new->val.count, new->val.data); + new->val.count-=1; + + return out; +} + +/** Gets a substring of the string */ +value String_substring(vm *v, int nargs, value *args) { + objectstring *slf = MORPHO_GETSTRING(MORPHO_SELF(args)); + value out=MORPHO_NIL; + int begin=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + int end=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); + + if (end<0 || (begin>=slf->length && begin>0) || end-begin<0) { + out=MORPHO_OBJECT(object_stringwithsize(0)); + } else { + begin=(begin<0) ? 0 : begin; + end=(end>slf->length) ? slf->length : end; + char *cstr = string_index(slf, begin); + + // Get size in bytes of the chars to include + char *cstrend = cstr; + for (int i = 0; ilength) -/** Use to create static strings on the C stack */ -#define MORPHO_STATICSTRING(cstring) { .obj.type=OBJECT_STRING, .obj.status=OBJECT_ISUNMANAGED, .obj.next=NULL, .string=cstring, .length=strlen(cstring) } +/** Use to create static strings on the C stack (cstring may be const char *). */ +#define MORPHO_STATICSTRING(cstring) { .obj.type=OBJECT_STRING, .obj.status=OBJECT_ISUNMANAGED, .obj.next=NULL, .string=(char *)(cstring), .length=strlen(cstring) } -/** Use to create static strings on the C stack */ -#define MORPHO_STATICSTRINGWITHLENGTH(cstring, len) { .obj.type=OBJECT_STRING, .obj.status=OBJECT_ISUNMANAGED, .obj.next=NULL, .string=cstring, .length=len } +/** Use to create static strings on the C stack (cstring may be const char *). */ +#define MORPHO_STATICSTRINGWITHLENGTH(cstring, len) { .obj.type=OBJECT_STRING, .obj.status=OBJECT_ISUNMANAGED, .obj.next=NULL, .string=(char *)(cstring), .length=len } #define OBJECT_STRINGLABEL "string" // These are only used by the parser... Should be moved? @@ -70,6 +70,7 @@ value object_concatenatestring(value a, value b); #define STRING_SPLIT_METHOD "split" #define STRING_ISNUMBER_METHOD "isnumber" +#define STRING_SUBSTRING_METHOD "substring" /* ------------------------------------------------------- * String error messages diff --git a/src/classes/system.c b/src/classes/system.c index 90550bd63..14a9b4cb0 100644 --- a/src/classes/system.c +++ b/src/classes/system.c @@ -10,6 +10,7 @@ #include "classes.h" #include "system.h" #include "platform.h" +#include "help.h" /* ********************************************************************** * System utility functions @@ -79,16 +80,19 @@ value System_print(vm *v, int nargs, value *args) { /** Sleep for a specified number of seconds */ value System_sleep(vm *v, int nargs, value *args) { - if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { - double t; - if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &t)) { - platform_sleep((int) (1000*t)); - } - } else morpho_runtimeerror(v, SLEEP_ARGS); + double t; + if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &t)) { + platform_sleep((int) (1000*t)); + } return MORPHO_NIL; } +value System_sleep__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, SLEEP_ARGS); + return MORPHO_NIL; +} + /** Readline */ value System_readline(vm *v, int nargs, value *args) { value out = MORPHO_NIL; @@ -118,13 +122,15 @@ value System_exit(vm *v, int nargs, value *args) { /** Set working folder */ value System_setworkingfolder(vm *v, int nargs, value *args) { - if (nargs==1 && - MORPHO_ISSTRING(MORPHO_GETARG(args, 0))) { - char *path = MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)); - - if (platform_setcurrentdirectory(path)) morpho_runtimeerror(v, SYS_STWRKDR); - } else morpho_runtimeerror(v, STWRKDR_ARGS); + char *path = MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)); + if (!platform_setcurrentdirectory(path)) morpho_runtimeerror(v, SYS_STWRKDR); + + return MORPHO_NIL; +} + +value System_setworkingfolder__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, STWRKDR_ARGS); return MORPHO_NIL; } @@ -162,18 +168,39 @@ value System_homefolder(vm *v, int nargs, value *args) { return out; } +/** Help query */ +value System_help__string(vm *v, int nargs, value *args) { + value out = MORPHO_NIL; + + char *query = MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)); + + varray_char result; + varray_charinit(&result); + + morpho_helpastext(query, &result); /* fills result with help text or a "not found" hint */ + out = object_stringfromvarraychar(&result); + if (MORPHO_ISOBJECT(out)) morpho_bindobjects(v, 1, &out); + varray_charclear(&result); + + return out; +} + MORPHO_BEGINCLASS(System) -MORPHO_METHOD(SYSTEM_PLATFORM_METHOD, System_platform, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SYSTEM_VERSION_METHOD, System_version, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SYSTEM_CLOCK_METHOD, System_clock, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, System_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SYSTEM_SLEEP_METHOD, System_sleep, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SYSTEM_READLINE_METHOD, System_readline, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SYSTEM_ARGUMENTS_METHOD, System_arguments, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SYSTEM_EXIT_METHOD, System_exit, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SYSTEM_SETWORKINGFOLDER_METHOD, System_setworkingfolder, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SYSTEM_WORKINGFOLDER_METHOD, System_workingfolder, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SYSTEM_HOMEFOLDER_METHOD, System_homefolder, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD_SIGNATURE(SYSTEM_PLATFORM_METHOD, "String ()", System_platform, MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(SYSTEM_VERSION_METHOD, "String ()", System_version, MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(SYSTEM_CLOCK_METHOD, "Float ()", System_clock, MORPHO_FN_IO|MORPHO_FN_NONDETERMINISTIC), +MORPHO_METHOD(MORPHO_PRINT_METHOD, System_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(SYSTEM_SLEEP_METHOD, "Nil (Int)", System_sleep, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(SYSTEM_SLEEP_METHOD, "Nil (Float)", System_sleep, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(SYSTEM_SLEEP_METHOD, "Nil (...)", System_sleep__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(SYSTEM_READLINE_METHOD, "String ()", System_readline, MORPHO_FN_IO|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(SYSTEM_ARGUMENTS_METHOD, "List ()", System_arguments, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(SYSTEM_EXIT_METHOD, "Nil ()", System_exit, MORPHO_FN_IO|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(SYSTEM_SETWORKINGFOLDER_METHOD, "Nil (String)", System_setworkingfolder, MORPHO_FN_IO|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(SYSTEM_SETWORKINGFOLDER_METHOD, "Nil (...)", System_setworkingfolder__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(SYSTEM_WORKINGFOLDER_METHOD, "String ()", System_workingfolder, MORPHO_FN_IO|MORPHO_FN_THROWS|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(SYSTEM_HOMEFOLDER_METHOD, "String ()", System_homefolder, MORPHO_FN_IO|MORPHO_FN_THROWS|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(SYSTEM_HELP_METHOD, "String (String)", System_help__string, MORPHO_FN_IO|MORPHO_FN_THROWS|MORPHO_FN_ALLOCATES) MORPHO_ENDCLASS /* ********************************************************************** @@ -181,8 +208,7 @@ MORPHO_ENDCLASS * ********************************************************************** */ void system_initialize(void) { - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); builtin_addclass(SYSTEM_CLASSNAME, MORPHO_GETCLASSDEFINITION(System), objclass); diff --git a/src/classes/system.h b/src/classes/system.h index 53123fe48..5710eb144 100644 --- a/src/classes/system.h +++ b/src/classes/system.h @@ -22,6 +22,7 @@ #define SYSTEM_READLINE_METHOD "readline" #define SYSTEM_SLEEP_METHOD "sleep" #define SYSTEM_ARGUMENTS_METHOD "arguments" +#define SYSTEM_HELP_METHOD "help" #define SYSTEM_EXIT_METHOD "exit" #define SYSTEM_HOMEFOLDER_METHOD "homefolder" diff --git a/src/classes/tuple.c b/src/classes/tuple.c index 23bbea040..2cd496dda 100644 --- a/src/classes/tuple.c +++ b/src/classes/tuple.c @@ -6,6 +6,7 @@ #include "morpho.h" #include "classes.h" +#include "common.h" /* ********************************************************************** * Tuple objects @@ -114,6 +115,47 @@ objecttuple *tuple_concatenate(objecttuple *a, objecttuple *b) { return new; } +/** Reverses a tuple, returning a new tuple */ +objecttuple *tuple_reverse(objecttuple *tuple) { + objecttuple *new = object_newtuple(tuple->length, tuple->tuple); + + if (new) { + unsigned int hlen = new->length / 2; + for (unsigned int i=0; ilength-i-1; + value swp = new->tuple[i]; + new->tuple[i]=new->tuple[j]; + new->tuple[j]=swp; + } + } + + return new; +} + +/** Rolls a tuple by a number of elements, returning a new tuple */ +objecttuple *tuple_roll(objecttuple *tuple, int nplaces) { + objecttuple *new=object_newtuple(tuple->length, NULL); + + if (new) { + unsigned int N = tuple->length; + if (N==0) return new; + + int n = abs(nplaces); + if (n>N) n = n % N; + unsigned int Np = N - n; + + if (nplaces<0) { + memcpy(new->tuple, tuple->tuple+n, sizeof(value)*Np); + memcpy(new->tuple+Np, tuple->tuple, sizeof(value)*n); + } else { + memcpy(new->tuple+n, tuple->tuple, sizeof(value)*Np); + if (n>0) memcpy(new->tuple, tuple->tuple+Np, sizeof(value)*n); + } + } + + return new; +} + /* ------------------------------------------------------- * Slicing * ------------------------------------------------------- */ @@ -160,13 +202,8 @@ errorid array_to_tuple_error(objectarrayerror err) { /** Constructor function for tuples */ value tuple_constructor(vm *v, int nargs, value *args) { - value out = MORPHO_NIL; objecttuple *new=object_newtuple(nargs, & MORPHO_GETARG(args, 0)); - if (new) { - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); - return out; + return morpho_wrapandbind(v, (object *) new); } /** Find a tuple's length */ @@ -178,15 +215,31 @@ value Tuple_count(vm *v, int nargs, value *args) { /** Clones a tuple */ value Tuple_clone(vm *v, int nargs, value *args) { - value out = MORPHO_NIL; objecttuple *slf = MORPHO_GETTUPLE(MORPHO_SELF(args)); objecttuple *new = object_newtuple(slf->length, slf->tuple); - if (new) { - out = MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); - + return morpho_wrapandbind(v, (object *) new); +} + +/** Convert a tuple to a string */ +value Tuple_tostring(vm *v, int nargs, value *args) { + objecttuple *tuple=MORPHO_GETTUPLE(MORPHO_SELF(args)); + value out = MORPHO_NIL; + + varray_char buffer; + varray_charinit(&buffer); + + varray_charadd(&buffer, "(", 1); + for (unsigned int i=0; ilength; i++) { + morpho_printtobuffer(v, tuple->tuple[i], &buffer); + if (ilength-1) varray_charadd(&buffer, ", ", 2); + } + varray_charadd(&buffer, ")", 1); + + out = object_stringfromvarraychar(&buffer); + if (MORPHO_ISSTRING(out)) morpho_bindobjects(v, 1, &out); + varray_charclear(&buffer); + return out; } @@ -222,62 +275,165 @@ value Tuple_setindex(vm *v, int nargs, value *args) { value Tuple_enumerate(vm *v, int nargs, value *args) { objecttuple *slf = MORPHO_GETTUPLE(MORPHO_SELF(args)); value out=MORPHO_NIL; + int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - if (nargs==1 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - int n=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - - if (n<0) { - out=MORPHO_INTEGER(slf->length); + if (n<0) { + out=MORPHO_INTEGER(slf->length); + } else { + if (nlength) { + out=slf->tuple[n]; } else { - if (nlength) { - out=slf->tuple[n]; - } else morpho_runtimeerror(v, VM_OUTOFBOUNDS); + morpho_runtimeerror(v, VM_OUTOFBOUNDS); } - } else MORPHO_RAISE(v, ENUMERATE_ARGS); + } return out; } +value Tuple_enumerate__err(vm *v, int nargs, value *args) { + MORPHO_RAISE(v, ENUMERATE_ARGS); + return MORPHO_NIL; +} + /** Joins two tuples together */ value Tuple_join(vm *v, int nargs, value *args) { objecttuple *slf = MORPHO_GETTUPLE(MORPHO_SELF(args)); - value out = MORPHO_NIL; + objecttuple *operand = MORPHO_GETTUPLE(MORPHO_GETARG(args, 0)); + objecttuple *new = tuple_concatenate(slf, operand); - if (nargs==1 && MORPHO_ISTUPLE(MORPHO_GETARG(args, 0))) { - objecttuple *operand = MORPHO_GETTUPLE(MORPHO_GETARG(args, 0)); - objecttuple *new = tuple_concatenate(slf, operand); + return morpho_wrapandbind(v, (object *) new); +} + +value Tuple_join__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, LIST_ADDARGS); + return MORPHO_NIL; +} + +/** Sort function for tuple_order */ +typedef struct { + unsigned int indx; + value val; +} tupleorderstruct; + +/** Sort function for tuple_order */ +int tuple_orderfunction(const void *a, const void *b) { + return -morpho_comparevalue(((tupleorderstruct *) a)->val, ((tupleorderstruct *) b)->val); +} + +/** Returns a tuple of indices giving the ordering of a tuple */ +objecttuple *tuple_order(objecttuple *tuple) { + tupleorderstruct *order = MORPHO_MALLOC(tuple->length*sizeof(tupleorderstruct)); + objecttuple *new = NULL; + + if (order) { + for (unsigned int i=0; ilength; i++) { + order[i].indx=i; + order[i].val=tuple->tuple[i]; + } + qsort(order, tuple->length, sizeof(tupleorderstruct), tuple_orderfunction); + new=object_newtuple(tuple->length, NULL); if (new) { - out = MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); + for (unsigned int i=0; ilength; i++) { + new->tuple[i]=MORPHO_INTEGER(order[i].indx); + } } - } else morpho_runtimeerror(v, LIST_ADDARGS); + MORPHO_FREE(order); + } - return out; + return new; +} + +/** Sorts the contents of a tuple, returning a new tuple */ +value Tuple_sort(vm *v, int nargs, value *args) { + objecttuple *src = MORPHO_GETTUPLE(MORPHO_SELF(args)); + + objecttuple *new = object_newtuple(src->length, src->tuple); + if (new) list_sortcontents(new->tuple, new->length); + + return morpho_wrapandbind(v, (object *) new); +} + +/** Sorts the contents of a tuple using a comparison function, returning a new tuple */ +value Tuple_sort_fn(vm *v, int nargs, value *args) { + objecttuple *src = MORPHO_GETTUPLE(MORPHO_SELF(args)); + + objecttuple *new=object_newtuple(src->length, src->tuple); + if (new) { + bool success=list_sortcontentswithfn(v, MORPHO_GETARG(args, 0), new->tuple, new->length); + if (!success) { + morpho_runtimeerror(v, LIST_SRTFN); + object_free((object *) new); + return MORPHO_NIL; + } + } + + return morpho_wrapandbind(v, (object *) new); +} + +/** Returns a tuple of indices that would sort the tuple self */ +value Tuple_order(vm *v, int nargs, value *args) { + objecttuple *slf = MORPHO_GETTUPLE(MORPHO_SELF(args)); + objecttuple *new=tuple_order(slf); + return morpho_wrapandbind(v, (object *) new); +} + +/** Returns a reversed copy of the tuple */ +value Tuple_reverse(vm *v, int nargs, value *args) { + objecttuple *slf = MORPHO_GETTUPLE(MORPHO_SELF(args)); + objecttuple *new=tuple_reverse(slf); + return morpho_wrapandbind(v, (object *) new); +} + +/** Rolls a tuple */ +value Tuple_roll(vm *v, int nargs, value *args) { + objecttuple *slf = MORPHO_GETTUPLE(MORPHO_SELF(args)); + int roll; + morpho_valuetoint(MORPHO_GETARG(args, 0), &roll); + + objecttuple *new = tuple_roll(slf, roll); + return morpho_wrapandbind(v, (object *) new); +} + +value Tuple_roll__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, LIST_ADDARGS); + return MORPHO_NIL; } /** Tests if a tuple has a value as a member */ value Tuple_ismember(vm *v, int nargs, value *args) { objecttuple *slf = MORPHO_GETTUPLE(MORPHO_SELF(args)); + return MORPHO_BOOL(tuple_ismember(slf, MORPHO_GETARG(args, 0))); +} - if (nargs==1) { - return MORPHO_BOOL(tuple_ismember(slf, MORPHO_GETARG(args, 0))); - } else morpho_runtimeerror(v, ISMEMBER_ARG, 1, nargs); - +value Tuple_ismember__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, ISMEMBER_ARG, 1, nargs); return MORPHO_NIL; } MORPHO_BEGINCLASS(Tuple) -MORPHO_METHOD(MORPHO_COUNT_METHOD, Tuple_count, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Tuple_clone, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Tuple_getindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Tuple_setindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Tuple_enumerate, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_JOIN_METHOD, Tuple_join, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(LIST_ISMEMBER_METHOD, Tuple_ismember, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CONTAINS_METHOD, Tuple_ismember, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD_SIGNATURE(MORPHO_COUNT_METHOD, "Int ()", Tuple_count, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Object_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_TOSTRING_METHOD, "String ()", Tuple_tostring, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_CLONE_METHOD, "Tuple ()", Tuple_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Tuple_getindex, MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Tuple_setindex, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ENUMERATE_METHOD, " (Int)", Tuple_enumerate, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ENUMERATE_METHOD, "Nil (...)", Tuple_enumerate__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_JOIN_METHOD, "Tuple (Tuple)", Tuple_join, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_JOIN_METHOD, "Nil (...)", Tuple_join__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ROLL_METHOD, "Tuple (Int)", Tuple_roll, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ROLL_METHOD, "Tuple (Float)", Tuple_roll, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ROLL_METHOD, "Nil (...)", Tuple_roll__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(LIST_SORT_METHOD, "Tuple ()", Tuple_sort, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(LIST_SORT_METHOD, "Tuple (Callable)", Tuple_sort_fn, MORPHO_FN_ALLOCATES|MORPHO_FN_REENTRANT|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(LIST_ORDER_METHOD, "Tuple ()", Tuple_order, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(LIST_REVERSE_METHOD, "Tuple ()", Tuple_reverse, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(LIST_ISMEMBER_METHOD, "Bool (_)", Tuple_ismember, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(LIST_ISMEMBER_METHOD, "Nil (...)", Tuple_ismember__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_CONTAINS_METHOD, "Bool (_)", Tuple_ismember, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_CONTAINS_METHOD, "Nil (...)", Tuple_ismember__err, MORPHO_FN_THROWS) MORPHO_ENDCLASS /* ********************************************************************** @@ -291,8 +447,7 @@ void tuple_initialize(void) { objecttupletype=object_addtype(&objecttupledefn); // Locate the Object class to use as the parent class of Range - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); - value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + value objclass = builtin_findclassfromcstring(OBJECT_CLASSNAME); // Create tuple veneer class value tupleclass=builtin_addclass(TUPLE_CLASSNAME, MORPHO_GETCLASSDEFINITION(Tuple), objclass); diff --git a/src/classes/upvalue.c b/src/classes/upvalue.c index 1e6b792cf..ad93b8bcf 100644 --- a/src/classes/upvalue.c +++ b/src/classes/upvalue.c @@ -33,7 +33,6 @@ objecttypedefn objectupvaluedefn = { .cmpfn=NULL }; - /** Initializes a new upvalue object. */ void object_upvalueinit(objectupvalue *c) { object_init(&c->obj, OBJECT_UPVALUE); diff --git a/src/classes/upvalue.h b/src/classes/upvalue.h index 7673b8ef8..5d689dd1d 100644 --- a/src/classes/upvalue.h +++ b/src/classes/upvalue.h @@ -21,6 +21,8 @@ typedef struct { indx reg; /** An index that either: if islocal - refers to the register OR otherwise - refers to the upvalue array in the current closure */ + value type; /** Type of the upvalue, if type protected (only set if islocal is true */ + value symbol; /** Symbol associated with the upvalue (only set if islocal is true) */ } upvalue; DECLARE_VARRAY(upvalue, upvalue) diff --git a/src/core/compile.c b/src/core/compile.c index 7b091cf82..96a6bcaf2 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -6,6 +6,7 @@ #include #include +#include #include "compile.h" #include "error.h" #include "vm.h" @@ -108,14 +109,18 @@ static void compiler_functionstateinit(functionstate *state) { state->func=NULL; state->scopedepth=0; state->loopdepth=0; + state->cfdepth=0; state->inargs=false; + state->hasreturn=false; state->nreg=0; state->type=FUNCTION; state->varg=REGISTER_UNALLOCATED; + state->typedec=MORPHO_NIL; varray_registerallocinit(&state->registers); varray_forwardreferenceinit(&state->forwardref); varray_upvalueinit(&state->upvalues); varray_functionrefinit(&state->functionref); + dictionary_init(&state->returntypes); } /** Clears a functionstate structure */ @@ -128,6 +133,7 @@ static void compiler_functionstateclear(functionstate *state) { varray_forwardreferenceclear(&state->forwardref); varray_upvalueclear(&state->upvalues); varray_functionrefclear(&state->functionref); + dictionary_clear(&state->returntypes); } /** Initializes the function stack */ @@ -221,11 +227,100 @@ objectfunction *compiler_getpreviousfunction(compiler *c) { return c->prevfunction; } +/** Sets the 'hasreturn' flag for the current function state */ +void compiler_sethasreturn(compiler *c) { + functionstate *f = compiler_currentfunctionstate(c); + f->hasreturn=true; +} + +/** Retrieves the 'hasreturn' flag for the current function state */ +bool compiler_hasreturn(compiler *c) { + functionstate *f = compiler_currentfunctionstate(c); + return f->hasreturn; +} + +bool compiler_regcurrenttype(compiler *c, registerindx reg, value *type); + +/** Sets the return type of a function */ +void compiler_addreturntype(compiler *c, value type) { + functionstate *f = compiler_currentfunctionstate(c); + + if (MORPHO_ISOBJECT(type)) dictionary_insert(&f->returntypes, type, MORPHO_NIL); + else dictionary_insert(&f->returntypes, MORPHO_FALSE, MORPHO_NIL); +} + +/** Sets the return type of a function from the contents of a given register */ +void compiler_addreturntypefromregister(compiler *c, registerindx ix) { + value type=MORPHO_NIL; + compiler_regcurrenttype(c, ix, &type); + compiler_addreturntype(c, type); +} + +static bool _retrieve(dictionary *dict, value *out) { + for (unsigned int i=0; icapacity; i++) { + if (!MORPHO_ISNIL(dict->contents[i].key)) { + *out = dict->contents[i].key; + return true; + } + } + return false; +} + +/** Resolve return type from the collection of possible types presented */ +void compiler_resolvereturntype(compiler *c) { + functionstate *f = compiler_currentfunctionstate(c); + objectfunction *func = compiler_getcurrentfunction(c); + value type=MORPHO_NIL; + + if (f->returntypes.count==1 && + _retrieve(&f->returntypes, &type)) { + if (MORPHO_ISEQUAL(type, MORPHO_FALSE)) type=MORPHO_NIL; // Check for ambiguous type + } + + signature_setreturntype(&func->sig, type); +} + +/** Infer the return type of a call target */ +void compiler_getreturntype(compiler *c, value target, value *type) { + signature *sig=metafunction_getsignature(target); + + if (sig) { + *type=signature_getreturntype(sig); + } else if (MORPHO_ISMETAFUNCTION(target)) { + metafunction_inferreturntype(MORPHO_GETMETAFUNCTION(target), type); + } +} + +/** Infer the return type of an invocation target */ +void compiler_getmethodreturntype(compiler *c, value klass, value target, value *type) { + value method=MORPHO_NIL; + if (MORPHO_ISCLASS(klass) && + dictionary_get(&MORPHO_GETCLASS(klass)->methods, target, &method)) { + compiler_getreturntype(c, method, type); + } +} + +/** Returns true if a class is exact for compile-time dispatch specialization. */ +static bool compiler_typeisexact(value type) { + return (MORPHO_ISCLASS(type) && MORPHO_GETCLASS(type)->children.count==0); +} + /* ------------------------------------------ * Types * ------------------------------------------- */ value _closuretype; +value _stringtype; +value _dicttype; +value _listtype; +value _rangetype; +value _tupletype; +value _complextype; + +value _inttype; +value _floattype; +value _booltype; +value _niltype; /* ------------------------------------------ * Argument declarations @@ -278,7 +373,7 @@ static objectclass *compiler_getcurrentclass(compiler *c) { /** Adds an objectclass to the compilers dictionary of classes */ void compiler_addclass(compiler *c, objectclass *klass) { - klass->uid = program_addclass(c->out, MORPHO_OBJECT(klass)); + program_addclass(c->out, MORPHO_OBJECT(klass)); dictionary_insert(&c->classes, klass->name, MORPHO_OBJECT(klass)); } @@ -326,26 +421,23 @@ bool compiler_findtypefromcstring(compiler *c, char *label, value *out) { /** Identifies a type from a value */ bool compiler_typefromvalue(compiler *c, value v, value *out) { - return metafunction_typefromvalue(v, out); -} - -/** Recursively searches the parents list of classes to see if the type 'match' is present */ -bool compiler_findtypeinparent(compiler *c, objectclass *type, value match) { - for (int i=0; iparents.count; i++) { - if (MORPHO_ISEQUAL(type->parents.data[i], match) || - compiler_findtypeinparent(c, MORPHO_GETCLASS(type->parents.data[i]), match)) return true; - } - return false; + return value_type(v, out); } /** Checks if type "match" matches a given type "type" */ bool compiler_checktype(compiler *c, value type, value match) { - if (MORPHO_ISNIL(type) || // If type is unset, we always match - MORPHO_ISEQUAL(type, match)) return true; // Or if the types are the same - - // Also match if 'match' inherits from 'type' - if (MORPHO_ISCLASS(match)) return compiler_findtypeinparent(c, MORPHO_GETCLASS(match), type); - + return value_typematch(type, match); +} + +/** Select the more specific type of two types; returns false if the types are contradictory*/ +bool compiler_mostspecifictype(compiler *c, value a, value b, value *out) { + if (MORPHO_ISNIL(a) || MORPHO_ISNIL(b)) { + *out=MORPHO_NIL; return true; + } else if (compiler_checktype(c, a, b)) { + *out=b; return true; + } else if (compiler_checktype(c, b, a)) { + *out=a; return true; + } return false; } @@ -355,6 +447,18 @@ bool compiler_getconstanttype(compiler *c, unsigned int i, value *type) { return compiler_typefromvalue(c, val, type); } +/** Sets typedec in the current functionstate; used to compile typed declarations */ +void compiler_settypedec(compiler *c, value type) { + functionstate *f = compiler_currentfunctionstate(c); + f->typedec=type; +} + +/** Returns the value of typedec in the current functionstate */ +value compiler_gettypedec(compiler *c) { + functionstate *f = compiler_currentfunctionstate(c); + return f->typedec; +} + /* ------------------------------------------ * Modules * ------------------------------------------- */ @@ -369,6 +473,28 @@ static value compiler_getmodule(compiler *c) { return c->currentmodule; } +/* ------------------------------------------ + * Control flow statements + * ------------------------------------------- */ + + /** Begin a control flow statement */ + static void compiler_begincontrolflow(compiler *c) { + functionstate *f = compiler_currentfunctionstate(c); + f->cfdepth++; + } + + /** End a control flow statement */ + static void compiler_endcontrolflow(compiler *c) { + functionstate *f = compiler_currentfunctionstate(c); + f->cfdepth--; + } + + /** Check if we are in a control flow statement */ + static bool compiler_incontrolflow(compiler *c) { + functionstate *f = compiler_currentfunctionstate(c); + return (f->cfdepth>0); + } + /* ------------------------------------------ * Loops * ------------------------------------------- */ @@ -404,12 +530,14 @@ static void compiler_fixloop(compiler *c, instructionindx start, instructionindx /** Begin a loop */ static void compiler_beginloop(compiler *c) { + compiler_begincontrolflow(c); functionstate *f = compiler_currentfunctionstate(c); f->loopdepth++; } /** End a loop */ static void compiler_endloop(compiler *c) { + compiler_endcontrolflow(c); functionstate *f = compiler_currentfunctionstate(c); f->loopdepth--; } @@ -419,6 +547,76 @@ static bool compiler_inloop(compiler *c) { functionstate *f = compiler_currentfunctionstate(c); return (f->loopdepth>0); } + +/* ------------------------------------------ + * Constants + * ------------------------------------------- */ + +/** Writes a constant to the current constant table + * @param c the compiler + * @param node current syntaxtree node + * @param constant the constant to add + * @param usestrict whether to use a strict e + * @param clone whether to clone the constant if it's not already present + * (typically this is set to copy strings from the syntax tree) */ +registerindx compiler_addconstant(compiler *c, syntaxtreenode *node, value constant, bool usestrict, bool clone) { + varray_value *konst = compiler_getcurrentconstanttable(c); + if (!konst) return REGISTER_UNALLOCATED; + + registerindx out=REGISTER_UNALLOCATED; + unsigned int prev=0; + + if (konst) { + /* Was a similar previous constant already added? */ + if (usestrict) { + if (varray_valuefindsame(konst, constant, &prev)) out=(registerindx) prev; + } else { + if (varray_valuefind(konst, constant, &prev)) out=(registerindx) prev; + } + + /* No, so create a new one */ + if (out==REGISTER_UNALLOCATED) { + if (konst->count>=MORPHO_MAXCONSTANTS) { + compiler_error(c, node, COMPILE_TOOMANYCONSTANTS); + return REGISTER_UNALLOCATED; + } else { + value add = constant; + if (clone && MORPHO_ISOBJECT(add)) { + /* If clone is set, we should try to clone the contents if the thing is an object. */ + if (MORPHO_ISSTRING(add)) { + add=object_clonestring(add); + } else if (MORPHO_ISCOMPLEX(add)) { + add=object_clonecomplexvalue(add); + } else { + UNREACHABLE("Erroneously being asked to clone a non-string non-complex constant."); + } + } + + bool success=varray_valueadd(konst, &add, 1); + out=konst->count-1; + if (!success) compiler_error(c, node, ERROR_ALLOCATIONFAILED); + + /* If the constant is an object and we cloned it, make sure it's bound to the program */ + if (clone && MORPHO_ISOBJECT(add)) { + program_bindobject(c->out, MORPHO_GETOBJECT(add)); + } + } + } + } + + return out; +} + +/** Write a symbol to the constant table, performing interning. + * @param c the compiler + * @param node current syntaxtree node + * @param symbol the constant to add */ +static registerindx compiler_addsymbol(compiler *c, syntaxtreenode *node, value symbol) { + /* Intern the symbol */ + value add=program_internsymbol(c->out, symbol); + + return compiler_addconstant(c, node, add, true, false); +} /* ------------------------------------------ * Register allocation and deallocation @@ -583,14 +781,34 @@ void compiler_regsettype(compiler *c, registerindx reg, value type) { f->registers.data[reg].type=type; } -/** Gets the current type of a register */ -bool compiler_regtype(compiler *c, registerindx reg, value *type) { - functionstate *f = compiler_currentfunctionstate(c); +/** Gets the current type of a register in a given functionstate */ +bool compiler_regtypefromfunctionstate(functionstate *f, registerindx reg, value *type) { if (reg>=f->registers.count) return false; *type = f->registers.data[reg].type; return true; } +/** Gets the symbol associated with a register */ +bool compiler_regsymbolfromfunctionstate(functionstate *f, registerindx reg, value *symbol) { + if (regregisters.count && f->registers.data[reg].isallocated) { + *symbol = f->registers.data[reg].symbol; + return true; + } + return false; +} + +/** Gets the current type of a register */ +bool compiler_regtype(compiler *c, registerindx reg, value *type) { + functionstate *f = compiler_currentfunctionstate(c); + return compiler_regtypefromfunctionstate(f, reg, type); +} + +/** Gets the current type of a register */ +bool compiler_regsymbol(compiler *c, registerindx reg, value *symbol) { + functionstate *f = compiler_currentfunctionstate(c); + return compiler_regsymbolfromfunctionstate(f, reg, symbol); +} + /** Raises a type violation error */ void compiler_typeviolation(compiler *c, syntaxtreenode *node, value type, value badtype, value symbol) { char *tname="(unknown)", *bname="(unknown)"; @@ -603,8 +821,24 @@ void compiler_typeviolation(compiler *c, syntaxtreenode *node, value type, value compiler_error(c, node, COMPILE_TYPEVIOLATION, bname, tname, sym); } -/** Sets the current type of a register. Raises a type violation error if this is not compatible with the required type */ -bool compiler_regsetcurrenttype(compiler *c, syntaxtreenode *node, registerindx reg, value type) { +/** Gets the current type of a register */ +bool compiler_regcurrenttype(compiler *c, registerindx reg, value *type) { + functionstate *f = compiler_currentfunctionstate(c); + if (reg>=f->registers.count) return false; + *type = f->registers.data[reg].currenttype; + return true; +} + +/** Sets the current type of a register. */ +bool compiler_regsetcurrenttype(compiler *c, registerindx reg, value type) { + functionstate *f = compiler_currentfunctionstate(c); + if (reg>=f->registers.count) return false; + f->registers.data[reg].currenttype=type; + return true; +} + +/** Tests if assigning a value of given type to a register is acceptable. If so, the type of the register is set; if not a type violation is raised */ +bool compiler_regcheckandsetcurrenttype(compiler *c, syntaxtreenode *node, registerindx reg, value type) { functionstate *f = compiler_currentfunctionstate(c); if (reg>=f->registers.count) return false; @@ -618,12 +852,27 @@ bool compiler_regsetcurrenttype(compiler *c, syntaxtreenode *node, registerindx return false; } -/** Gets the current type of a register */ -bool compiler_regcurrenttype(compiler *c, registerindx reg, value *type) { - functionstate *f = compiler_currentfunctionstate(c); - if (reg>=f->registers.count) return false; - *type = f->registers.data[reg].currenttype; - return true; +/** Performs a type check on register reg against a given type. Codeinfo is updated if a typecheck instruction needs to be generated */ +bool compiler_regtypecheck(compiler *c, syntaxtreenode *node, registerindx reg, value type, value symbol, codeinfo *info) { + bool success=false; + + value rtype=MORPHO_NIL; // Get the current type held in register reg + compiler_regcurrenttype(c, reg, &rtype); + + if (MORPHO_ISNIL(type)) { // Not type protected + success=true; + } else if (MORPHO_ISNIL(rtype)) { // Type unknown; generate dynamic typecheck against type + registerindx ctype = compiler_addconstant(c, node, type, false, false); + compiler_addinstruction(c, ENCODE_LONG(OP_TYPECHECK, reg, ctype), node); + info->ninstructions++; + success=true; + } else if (compiler_checktype(c, type, rtype)) { // Successful type check + success=true; + } else { // Type is incompatible + compiler_typeviolation(c, node, type, rtype, symbol); + } + + return success; } /** @brief Finds the register that contains symbol in a given functionstate @@ -739,9 +988,7 @@ static bool compiler_iscodeinfotop(compiler *c, codeinfo func) { } /** @brief Shows the current allocation of the registers */ -static void compiler_regshow(compiler *c) { - functionstate *f = compiler_currentfunctionstate(c); - +void compiler_regshowwithfunctionstate(functionstate *f) { printf("--Registers (%u in use)\n",f->nreg); for (unsigned int i=0; iregisters.count; i++) { registeralloc *r=f->registers.data+i; @@ -774,102 +1021,15 @@ static void compiler_regshow(compiler *c) { printf("--End registers\n"); } -/* ------------------------------------------ - * Track scope - * ------------------------------------------- */ - -/** Increments the scope counter in the current functionstate */ -void compiler_beginscope(compiler *c) { - functionstate *f=compiler_currentfunctionstate(c); - f->scopedepth++; -} - -void compiler_functionreffreeatscope(compiler *c, unsigned int scope); - -/** Decrements the scope counter in the current functionstate */ -void compiler_endscope(compiler *c) { - functionstate *f=compiler_currentfunctionstate(c); - compiler_regfreeatscope(c, f->scopedepth); - compiler_functionreffreeatscope(c, f->scopedepth); - f->scopedepth--; -} - -/** Gets the scope counter in the current functionstate */ -unsigned int compiler_currentscope(compiler *c) { - functionstate *f=compiler_currentfunctionstate(c); - return f->scopedepth; +void compiler_regshow(compiler *c) { + functionstate *f = compiler_currentfunctionstate(c); + compiler_regshowwithfunctionstate(f); } /* ------------------------------------------ - * Constants + * Materialize a builtin function * ------------------------------------------- */ -/** Writes a constant to the current constant table - * @param c the compiler - * @param node current syntaxtree node - * @param constant the constant to add - * @param usestrict whether to use a strict e - * @param clone whether to clone the constant if it's not already present - * (typically this is set to copy strings from the syntax tree) */ -static registerindx compiler_addconstant(compiler *c, syntaxtreenode *node, value constant, bool usestrict, bool clone) { - varray_value *konst = compiler_getcurrentconstanttable(c); - if (!konst) return REGISTER_UNALLOCATED; - - registerindx out=REGISTER_UNALLOCATED; - unsigned int prev=0; - - if (konst) { - /* Was a similar previous constant already added? */ - if (usestrict) { - if (varray_valuefindsame(konst, constant, &prev)) out=(registerindx) prev; - } else { - if (varray_valuefind(konst, constant, &prev)) out=(registerindx) prev; - } - - /* No, so create a new one */ - if (out==REGISTER_UNALLOCATED) { - if (konst->count>=MORPHO_MAXCONSTANTS) { - compiler_error(c, node, COMPILE_TOOMANYCONSTANTS); - return REGISTER_UNALLOCATED; - } else { - value add = constant; - if (clone && MORPHO_ISOBJECT(add)) { - /* If clone is set, we should try to clone the contents if the thing is an object. */ - if (MORPHO_ISSTRING(add)) { - add=object_clonestring(add); - } else if (MORPHO_ISCOMPLEX(add)) { - add=object_clonecomplexvalue(add); - } else { - UNREACHABLE("Erroneously being asked to clone a non-string non-complex constant."); - } - } - - bool success=varray_valueadd(konst, &add, 1); - out=konst->count-1; - if (!success) compiler_error(c, node, ERROR_ALLOCATIONFAILED); - - /* If the constant is an object and we cloned it, make sure it's bound to the program */ - if (clone && MORPHO_ISOBJECT(add)) { - program_bindobject(c->out, MORPHO_GETOBJECT(add)); - } - } - } - } - - return out; -} - -/** Write a symbol to the constant table, performing interning. - * @param c the compiler - * @param node current syntaxtree node - * @param symbol the constant to add */ -static registerindx compiler_addsymbol(compiler *c, syntaxtreenode *node, value symbol) { - /* Intern the symbol */ - value add=program_internsymbol(c->out, symbol); - - return compiler_addconstant(c, node, add, true, false); -} - /** Finds a builtin function and loads it into a register at the top of the stack * @param c the compiler * @param node current syntax tree node @@ -901,6 +1061,32 @@ codeinfo compiler_findbuiltin(compiler *c, syntaxtreenode *node, char *name, reg return ret; } +/* ------------------------------------------ + * Track scope + * ------------------------------------------- */ + +/** Increments the scope counter in the current functionstate */ +void compiler_beginscope(compiler *c) { + functionstate *f=compiler_currentfunctionstate(c); + f->scopedepth++; +} + +void compiler_functionreffreeatscope(compiler *c, unsigned int scope); + +/** Decrements the scope counter in the current functionstate */ +void compiler_endscope(compiler *c) { + functionstate *f=compiler_currentfunctionstate(c); + compiler_regfreeatscope(c, f->scopedepth); + compiler_functionreffreeatscope(c, f->scopedepth); + f->scopedepth--; +} + +/** Gets the scope counter in the current functionstate */ +unsigned int compiler_currentscope(compiler *c) { + functionstate *f=compiler_currentfunctionstate(c); + return f->scopedepth; +} + /* ------------------------------------------ * Local variables * ------------------------------------------- */ @@ -949,6 +1135,11 @@ static registerindx compiler_getlocal(compiler *c, value symbol) { return false; }*/ +bool compiler_getglobaltype(compiler *c, globalindx indx, value *type); +bool compiler_getglobalsymbol(compiler *c, globalindx indx, value *symbol); +bool compiler_getupvaluetype(compiler *c, registerindx ix, value *type); +bool compiler_getupvaluesymbol(compiler *c, registerindx ix, value *symbol); + /** @brief Moves the results of a codeinfo block into a register * @details includes constants, upvalues etc. * @param c the current compiler @@ -957,7 +1148,7 @@ static registerindx compiler_getlocal(compiler *c, value symbol) { * @param reg destination register, or REGISTER_UNALLOCATED to allocate a new one * @returns Number of instructions generated */ static codeinfo compiler_movetoregister(compiler *c, syntaxtreenode *node, codeinfo info, registerindx reg) { - value type = MORPHO_NIL; + value type = MORPHO_NIL, symbol = MORPHO_NIL; codeinfo out = info; out.ninstructions=0; @@ -966,7 +1157,7 @@ static codeinfo compiler_movetoregister(compiler *c, syntaxtreenode *node, codei out.dest=compiler_regtemp(c, reg); if (compiler_getconstanttype(c, info.dest, &type)) { - compiler_regsetcurrenttype(c, node, out.dest, type); + if (!compiler_regcheckandsetcurrenttype(c, node, out.dest, type)) return CODEINFO_EMPTY; } compiler_addinstruction(c, ENCODE_LONG(OP_LCT, out.dest, info.dest), node); @@ -977,12 +1168,30 @@ static codeinfo compiler_movetoregister(compiler *c, syntaxtreenode *node, codei out.returntype=REGISTER; compiler_addinstruction(c, ENCODE_DOUBLE(OP_LUP, out.dest, info.dest), node); out.ninstructions++; + + if (compiler_getupvaluetype(c, info.dest, &type)) { + compiler_regsetcurrenttype(c, out.dest, type); + } + + if (compiler_regtype(c, out.dest, &type)) { // Check that the value loaded is valid + compiler_getupvaluesymbol(c, info.dest, &symbol); + compiler_regtypecheck(c, node, out.dest, type, symbol, &out); + } } else if (CODEINFO_ISGLOBAL(info)) { /* Move globals */ out.dest=compiler_regtemp(c, reg); out.returntype=REGISTER; compiler_addinstruction(c, ENCODE_LONG(OP_LGL, out.dest, info.dest), node); out.ninstructions++; + + if (compiler_getglobaltype(c, info.dest, &type)) { + compiler_regsetcurrenttype(c, out.dest, type); + } + + if (compiler_regtype(c, out.dest, &type)) { // Check that the value loaded is valid + compiler_getglobalsymbol(c, info.dest, &symbol); + compiler_regtypecheck(c, node, out.dest, type, symbol, &out); + } } else { /* Move between registers */ if (reg==REGISTER_UNALLOCATED) { @@ -992,7 +1201,15 @@ static codeinfo compiler_movetoregister(compiler *c, syntaxtreenode *node, codei } if (out.dest!=info.dest) { - if (compiler_regcurrenttype(c, info.dest, &type)) compiler_regsetcurrenttype(c, node, out.dest, type); + value ctype=MORPHO_NIL; + if (compiler_regtype(c, out.dest, &type) && + compiler_regsymbol(c, out.dest, &symbol) && + compiler_regtypecheck(c, node, info.dest, type, symbol, &out) && + compiler_regcurrenttype(c, info.dest, &ctype) && + compiler_mostspecifictype(c, type, ctype, &type)) { + + compiler_regsetcurrenttype(c, out.dest, type); + } compiler_addinstruction(c, ENCODE_DOUBLE(OP_MOV, out.dest, info.dest), node); out.ninstructions++; @@ -1112,20 +1329,14 @@ void compiler_setglobaltype(compiler *c, globalindx indx, value type) { program_globalsettype(c->out, indx, type); } -/** Checks if the type match satisfies the type of the global variable indx */ -bool compiler_checkglobaltype(compiler *c, syntaxtreenode *node, globalindx indx, value match) { - value type=MORPHO_NIL; - if (!program_globaltype(c->out, indx, &type)) return false; - - bool success=compiler_checktype(c, type, match); - - if (!success) { - value symbol=MORPHO_NIL; - program_globalsymbol(c->out, indx, &symbol); - compiler_typeviolation(c, node, type, match, symbol); - } - - return success; +/** Gets the type of a global variable */ +bool compiler_getglobaltype(compiler *c, globalindx indx, value *type) { + return program_globaltype(c->out, indx, type); +} + +/** Gets the type of a global variable */ +bool compiler_getglobalsymbol(compiler *c, globalindx indx, value *symbol) { + return program_globalsymbol(c->out, indx, symbol); } /** Shows all currently allocated globals */ @@ -1158,9 +1369,10 @@ codeinfo compiler_movetoglobal(compiler *c, syntaxtreenode *node, codeinfo in, g tmp=true; } - value type=MORPHO_NIL; - if (compiler_regcurrenttype(c, in.dest, &type)) { - if (!compiler_checkglobaltype(c, node, slot, type)) goto compiler_movetoglobal_cleanup; + value type=MORPHO_NIL, symbol=MORPHO_NIL; + if (compiler_getglobaltype(c, slot, &type)) { + compiler_getglobalsymbol(c, slot, &symbol); + if (!compiler_regtypecheck(c, node, use.dest, type, symbol, &out)) goto compiler_movetoglobal_cleanup; } compiler_addinstruction(c, ENCODE_LONG(OP_SGL, use.dest, slot) , node); @@ -1191,8 +1403,8 @@ codeinfo compiler_addvariable(compiler *c, syntaxtreenode *node, value symbol) { * ------------------------------------------- */ /** Adds an upvalue to a functionstate */ -registerindx compiler_addupvalue(functionstate *f, bool islocal, indx ix) { - upvalue v = (upvalue) { .islocal = islocal, .reg = ix}; +registerindx compiler_addupvalue(functionstate *f, bool islocal, registerindx ix) { + upvalue v = (upvalue) { .islocal = islocal, .reg = ix, .type=MORPHO_NIL, .symbol=MORPHO_NIL }; /* Does this upvalue already exist? */ for (registerindx i=0; iupvalues.count; i++) { @@ -1203,7 +1415,12 @@ registerindx compiler_addupvalue(functionstate *f, bool islocal, indx ix) { } } - /* If not, add it */ + /* If not, get type information and add it */ + if (islocal) { + compiler_regtypefromfunctionstate(f, (registerindx) ix, &v.type); + compiler_regsymbolfromfunctionstate(f, ix, &v.symbol); + } + varray_upvalueadd(&f->upvalues, &v, 1); return (registerindx) f->upvalues.count-1; } @@ -1221,6 +1438,34 @@ registerindx compiler_propagateupvalues(compiler *c, functionstate *start, regis return indx; } +/** Find the original upvalue from the */ +bool compiler_getupvalue(compiler *c, registerindx ix, upvalue **v) { + registerindx i=ix; + for (functionstate *f = compiler_currentfunctionstate(c)-1; f>=c->fstack; f--) { + upvalue *u = &f->upvalues.data[i]; + + if (u->islocal) { + *v = u; return true; + } else i=(registerindx) u->reg; + } + + return false; +} + +/** Determines the type associated with an upvalue in the current scope */ +bool compiler_getupvaluetype(compiler *c, registerindx ix, value *type) { + upvalue *u = NULL; + if (compiler_getupvalue(c, ix, &u)) *type=u->type; + return u; +} + +/** Determines the symbol associated with an upvalue in the current scope */ +bool compiler_getupvaluesymbol(compiler *c, registerindx ix, value *symbol) { + upvalue *u = NULL; + if (compiler_getupvalue(c, ix, &u)) *symbol=u->symbol; + return u; +} + /** @brief Determines whether a symbol refers to something outside its scope @param c the compiler @param symbol symbol to resolve @@ -1258,6 +1503,18 @@ static codeinfo compiler_movetoupvalue(compiler *c, syntaxtreenode *node, codein tmp=true; } + // Typecheck the assignment + value uptype, rtype; + if (compiler_getupvaluetype(c, slot, &uptype) && + compiler_regcurrenttype(c, use.dest, &rtype) && + !compiler_checktype(c, uptype, rtype)) { + + value upsymbol=MORPHO_NIL; + compiler_getupvaluesymbol(c, slot, &upsymbol); + + compiler_typeviolation(c, node, uptype, rtype, upsymbol); + } + compiler_addinstruction(c, ENCODE_DOUBLE(OP_SUP, slot, use.dest), node); out.ninstructions++; @@ -1301,20 +1558,14 @@ void compiler_functionreffreeatscope(compiler *c, unsigned int scope) { } void _addmatchingfunctionref(compiler *c, value symbol, value fn, value *out) { - value in = *out; - if (MORPHO_ISNIL(in)) { - // If the function has a signature, will need to wrap in a metafunction - if (MORPHO_ISFUNCTION(fn) && function_hastypedparameters(MORPHO_GETFUNCTION(fn))) { - if (metafunction_wrap(symbol, fn, out)) { - program_bindobject(c->out, MORPHO_GETOBJECT(*out)); - } - } else *out=fn; - } else if (MORPHO_ISFUNCTION(in)) { - if (metafunction_wrap(symbol, in, out)) { metafunction_add(MORPHO_GETMETAFUNCTION(*out), fn); - program_bindobject(c->out, MORPHO_GETOBJECT(*out)); - } - } else if (MORPHO_ISMETAFUNCTION(in)) { - metafunction_add(MORPHO_GETMETAFUNCTION(in), fn); + value prev = *out, incoming = fn; + + if (MORPHO_ISNIL(prev) && MORPHO_ISFUNCTION(fn) && function_hastypedparameters(MORPHO_GETFUNCTION(fn))) { + if (!metafunction_wrap(symbol, fn, &incoming)) return; + } + + if (metafunction_merge(symbol, prev, incoming, NULL, out) && MORPHO_ISMETAFUNCTION(*out) && !MORPHO_ISSAME(prev, *out)) { + program_bindobject(c->out, MORPHO_GETOBJECT(*out)); } } @@ -1404,7 +1655,7 @@ static void _findfunctionref(compiler *c, value symbol, bool *hasclosure, varray varray_functionrefinit(&refs); functionstate *fc = compiler_currentfunctionstate(c); - for (functionstate *f=fc; f>=c->fstack; f--) { // Go backwards to prioritize recent def'ns + for (functionstate *f=fc; f>=c->fstack; f--) { // Go backwards on the functionstate stack to prioritize recent def'ns for (int i=f->functionref.count-1; i>=0; i--) { // Go backwards functionref *ref=&f->functionref.data[i]; if (MORPHO_ISEQUAL(ref->symbol, symbol) && @@ -1413,6 +1664,15 @@ static void _findfunctionref(compiler *c, value symbol, bool *hasclosure, varray varray_functionrefadd(&refs, ref, 1); } } + + // Check to see if there was a matching symbol in this scope that *isn't* a closure + registerindx rsym = compiler_findsymbol(f, symbol); + value type; + if (rsym>=0 && + compiler_regcurrenttype(c, rsym, &type) && + !MORPHO_ISEQUAL(type, _closuretype)) { + break; // If there is, then we halt the search + } } // Return the collected implementations @@ -1451,7 +1711,7 @@ bool compiler_resolvefunctionref(compiler *c, syntaxtreenode *node, value symbol } if (MORPHO_ISMETAFUNCTION(outfn)) { - metafunction_compile(MORPHO_GETMETAFUNCTION(outfn), &c->err); + metafunction_finalize(MORPHO_GETMETAFUNCTION(outfn), &c->err); } out->returntype=CONSTANT; @@ -1678,6 +1938,7 @@ static codeinfo compiler_break(compiler *c, syntaxtreenode *node, registerindx r static codeinfo compiler_try(compiler *c, syntaxtreenode *node, registerindx reqout); static codeinfo compiler_logical(compiler *c, syntaxtreenode *node, registerindx reqout); static codeinfo compiler_declaration(compiler *c, syntaxtreenode *node, registerindx out); +static codeinfo compiler_typeddeclaration(compiler *c, syntaxtreenode *node, registerindx out); static codeinfo compiler_function(compiler *c, syntaxtreenode *node, registerindx out); static codeinfo compiler_arglist(compiler *c, syntaxtreenode *node, registerindx out); static codeinfo compiler_call(compiler *c, syntaxtreenode *node, registerindx out); @@ -1748,7 +2009,7 @@ compilenoderule noderules[] = { { compiler_print }, // NODE_PRINT { compiler_declaration }, // NODE_DECLARATION - { compiler_declaration }, // NODE_TYPE + { compiler_typeddeclaration }, // NODE_TYPE { compiler_function }, // NODE_FUNCTION { NODE_NORULE }, // NODE_METHOD { compiler_class }, // NODE_CLASS @@ -1797,15 +2058,17 @@ static codeinfo compiler_list(compiler *c, syntaxtreenode *node, registerindx re syntaxtreenodetype dictentrytype[] = { NODE_ARGLIST }; varray_syntaxtreeindx entries; - /* Set up a call to the List() function */ + /* Set up a call to the List() or Tuple() function as appropriate */ char *classname = LIST_CLASSNAME; - if (node->type==NODE_TUPLE) classname = TUPLE_CLASSNAME; + value type = _listtype; + if (node->type==NODE_TUPLE) { + classname = TUPLE_CLASSNAME; + type = _tupletype; + } + codeinfo out = compiler_findbuiltin(c, node, classname, reqout); - value listtype=MORPHO_NIL; /* Set the type associated with the register */ - if (compiler_findtypefromcstring(c, classname, &listtype)) { - if (!compiler_regsetcurrenttype(c, node, out.dest, listtype)) return CODEINFO_EMPTY; - } + if (!compiler_regcheckandsetcurrenttype(c, node, out.dest, type)) return CODEINFO_EMPTY; varray_syntaxtreeindxinit(&entries); if (node->right!=SYNTAXTREE_UNCONNECTED) syntaxtree_flatten(compiler_getsyntaxtree(c), node->right, 1, dictentrytype, &entries); @@ -1845,10 +2108,7 @@ static codeinfo compiler_dictionary(compiler *c, syntaxtreenode *node, registeri /* Set up a call to the Dictionary() function */ codeinfo out = compiler_findbuiltin(c, node, DICTIONARY_CLASSNAME, reqout); - value dicttype=MORPHO_NIL; /* Set the type associated with the register */ - if (compiler_findtypefromcstring(c, DICTIONARY_CLASSNAME, &dicttype)) { - if (!compiler_regsetcurrenttype(c, node, out.dest, dicttype)) return CODEINFO_EMPTY; - } + if (!compiler_regcheckandsetcurrenttype(c, node, out.dest, _dicttype)) return CODEINFO_EMPTY; varray_syntaxtreeindxinit(&entries); /* Flatten all the child nodes; these end up as a sequence: key, val, key, val, ... */ @@ -1900,10 +2160,7 @@ static codeinfo compiler_range(compiler *c, syntaxtreenode *node, registerindx r /* Set up a call to the Range() function */ codeinfo rng = compiler_findbuiltin(c, node, (inclusive ? RANGE_INCLUSIVE_CONSTRUCTOR: RANGE_CLASSNAME), reqout); - value rngtype=MORPHO_NIL; /* Set the type associated with the register */ - if (compiler_findtypefromcstring(c, RANGE_CLASSNAME, &rngtype)) { - if (!compiler_regsetcurrenttype(c, node, rng.dest, rngtype)) return CODEINFO_EMPTY; - } + if (!compiler_regcheckandsetcurrenttype(c, node, rng.dest, _rangetype)) return CODEINFO_EMPTY; /* Construct the arguments */ unsigned int n; @@ -1976,21 +2233,31 @@ static codeinfo compiler_index(compiler *c, syntaxtreenode *node, registerindx r if (compiler_haserror(c)) return CODEINFO_EMPTY; ninstructions+=out.ninstructions; + /* Destination register */ + codeinfo iout = CODEINFO(REGISTER, start, ninstructions); + /* Compile instruction */ compiler_addinstruction(c, ENCODE(OP_LIX, left.dest, start, end), node); ninstructions++; + // Update type information + compiler_regsetcurrenttype(c, start, MORPHO_NIL); // Result of LIX is always unknown type + value type; + if (compiler_regtype(c, start, &type)) { + value symbol=MORPHO_NIL; + compiler_regsymbol(c, start, &symbol); + compiler_regtypecheck(c, node, start, type, symbol, &iout); + } + /* Free anything we're done with */ compiler_releaseoperand(c, left); compiler_regfreetoend(c, start+1); - codeinfo iout = CODEINFO(REGISTER, start, ninstructions); - if (reqout>=0 && start!=reqout) { - compiler_regfreetemp(c, start); iout = compiler_movetoregister(c, node, iout, reqout); ninstructions+=iout.ninstructions; + compiler_regfreetemp(c, start); } iout.ninstructions=ninstructions; @@ -2045,6 +2312,8 @@ static codeinfo compiler_not(compiler *c, syntaxtreenode *node, registerindx req ninstructions+=left.ninstructions; } + if (!compiler_regcheckandsetcurrenttype(c, node, out, _booltype)) return CODEINFO_EMPTY; + compiler_addinstruction(c, ENCODE_DOUBLE(OP_NOT, out, left.dest), node); ninstructions++; compiler_releaseoperand(c, left); @@ -2052,9 +2321,66 @@ static codeinfo compiler_not(compiler *c, syntaxtreenode *node, registerindx req return CODEINFO(REGISTER, out, ninstructions); } +/** Finds a method */ +bool compiler_findmethodreturntype(value klass, char *label, value *type) { + if (!MORPHO_ISCLASS(klass)) return false; + + objectstring selector = MORPHO_STATICSTRING(label); + value method = MORPHO_NIL; + if (dictionary_get(&MORPHO_GETCLASS(klass)->methods, MORPHO_OBJECT(&selector), &method)) { + signature *s = metafunction_getsignature(method); + if (s) { *type = signature_getreturntype(s); return true; } + } + + return false; +} + +/** Opcode redirection */ +typedef struct { + instruction op; /** Opcode */ + char *lfunc; /** Label for reg */ + char *rfunc; /** Display code - rX is register, cX is constant X, gX is global X, uX is upvalue, + refers to signed B */ +} opcodedispatchrule; + +/** Define how opcodes are redirected @warning: Must match opcode definition order */ +opcodedispatchrule opcodedispatchrules[] ={ + { OP_ADD, MORPHO_ADD_METHOD, MORPHO_ADDR_METHOD }, + { OP_SUB, MORPHO_SUB_METHOD, MORPHO_SUBR_METHOD }, + { OP_MUL, MORPHO_MUL_METHOD, MORPHO_MULR_METHOD }, + { OP_DIV, MORPHO_DIV_METHOD, MORPHO_DIVR_METHOD }, + { OP_POW, MORPHO_POW_METHOD, MORPHO_POWR_METHOD }, +}; + +bool _isreal(value r) { + return MORPHO_ISEQUAL(r, _inttype) || MORPHO_ISEQUAL(r, _floattype); +} + +bool compiler_arithmetictype(compiler *c, opcode op, registerindx left, registerindx right, value *type) { + bool success=false; + value ltype=MORPHO_NIL, rtype=MORPHO_NIL; + + if (compiler_regcurrenttype(c, left, <ype) && + compiler_regcurrenttype(c, right, &rtype)) { + + if (MORPHO_ISEQUAL(ltype,_inttype) && MORPHO_ISEQUAL(rtype,_inttype) && + op!=OP_POW && op!=OP_DIV) { + *type=_inttype; + success=true; + } else if (_isreal(ltype) && _isreal(rtype)) { + *type=_floattype; + success=true; + } else { + success=compiler_findmethodreturntype(ltype, opcodedispatchrules[op-OP_ADD].lfunc, type); + if (!success) success=compiler_findmethodreturntype(rtype, opcodedispatchrules[op-OP_ADD].rfunc, type); + } + } + return success; +} + /** Compile arithmetic operators */ static codeinfo compiler_binary(compiler *c, syntaxtreenode *node, registerindx reqout) { codeinfo left = compiler_nodetobytecode(c, node->left, REGISTER_UNALLOCATED); + unsigned int ninstructions=left.ninstructions; if (!(CODEINFO_ISREGISTER(left))) { /* Ensure we're working with a register */ @@ -2070,7 +2396,7 @@ static codeinfo compiler_binary(compiler *c, syntaxtreenode *node, registerindx ninstructions+=right.ninstructions; } - registerindx out = compiler_regtemp(c, reqout); + registerindx rout = compiler_regtemp(c, reqout); opcode op=OP_NOP; @@ -2102,12 +2428,31 @@ static codeinfo compiler_binary(compiler *c, syntaxtreenode *node, registerindx if (compiler_haserror(c)) return CODEINFO_EMPTY; - compiler_addinstruction(c, ENCODE(op, out, left.dest, right.dest), node); + compiler_addinstruction(c, ENCODE(op, rout, left.dest, right.dest), node); ninstructions++; - compiler_releaseoperand(c, left); + + /* Set the output type of the operation */ + // TODO: Check input types? + value type = MORPHO_NIL; + if (op<=OP_POW) { // Arithmetic type + compiler_arithmetictype(c, op, left.dest, right.dest, &type); + } else { // Comparison operations + type=_booltype; + } + + compiler_releaseoperand(c, left); // Release operands after type information determined compiler_releaseoperand(c, right); + + codeinfo out = CODEINFO(REGISTER, rout, ninstructions); + + value rtype=MORPHO_NIL, symbol = MORPHO_NIL; + if (compiler_regtype(c, rout, &rtype) && + compiler_regsymbol(c, rout, &symbol)) { + compiler_regsetcurrenttype(c, rout, type); + compiler_regtypecheck(c, node, rout, rtype, symbol, &out); + } - return CODEINFO(REGISTER, out, ninstructions); + return out; } /** @brief Compiles the ternary operator @@ -2245,14 +2590,17 @@ static codeinfo compiler_interpolation(compiler *c, syntaxtreenode *node, regist compiler_regfreetoend(c, r+1); } } - - compiler_addinstruction(c, ENCODE(OP_CAT, (reqout!=REGISTER_UNALLOCATED ? reqout : start), start, r), node); + + registerindx rout = (reqout!=REGISTER_UNALLOCATED ? reqout : start); + compiler_addinstruction(c, ENCODE(OP_CAT, rout, start, r), node); ninstructions++; + + if (!compiler_regcheckandsetcurrenttype(c, node, rout, _stringtype)) return CODEINFO_EMPTY; /* Free all the registers used, including start if it wasn't the destination for the output */ if (start!=REGISTER_UNALLOCATED) compiler_regfreetoend(c, start + (reqout!=REGISTER_UNALLOCATED ? 0: 1)); - return CODEINFO(REGISTER, (reqout!=REGISTER_UNALLOCATED ? reqout : start), ninstructions); + return CODEINFO(REGISTER, rout, ninstructions); } /** Inserts instructions to close upvalues */ @@ -2373,6 +2721,8 @@ static codeinfo compiler_if(compiler *c, syntaxtreenode *node, registerindx reqo ifindx=compiler_addinstruction(c, ENCODE_BYTE(OP_NOP), node); ninstructions++; + compiler_begincontrolflow(c); + if (right->type==NODE_THEN) { /* If the right node is a THEN node, the then/else statements are located off it. */ if (!unreachable) { @@ -2396,6 +2746,8 @@ static codeinfo compiler_if(compiler *c, syntaxtreenode *node, registerindx reqo ninstructions+=then.ninstructions; } + compiler_endcontrolflow(c); + /* Now generate the conditional branch over the then clause */ compiler_setinstruction(c, ifindx, ENCODE_LONG(OP_BIFF, cond.dest, then.ninstructions+nextra)); @@ -2580,6 +2932,8 @@ static codeinfo compiler_for(compiler *c, syntaxtreenode *node, registerindx req compiler_addinstruction(c, ENCODE_LONG(OP_LCT, rIndx, cNil), node); ninstructions++; + if (!compiler_regcheckandsetcurrenttype(c, node, rIndx, _inttype)) return CODEINFO_EMPTY; + /* Obtain the maximum value of rIndx by invoking enumerate */ // Allocate register to contain maximum value of the counter @@ -2768,8 +3122,10 @@ static codeinfo compiler_try(compiler *c, syntaxtreenode *node, registerindx req compiler_addinstruction(c, ENCODE_LONG(OP_PUSHERR, 0, cdictindx), node); out.ninstructions++; + compiler_begincontrolflow(c); + debugannotation_pusherr(&c->out->annotations, cdict); - + /* Compile the body */ if (node->left!=SYNTAXTREE_UNCONNECTED) { codeinfo body = compiler_nodetobytecode(c, node->left, REGISTER_UNALLOCATED); @@ -2838,6 +3194,8 @@ static codeinfo compiler_try(compiler *c, syntaxtreenode *node, registerindx req varray_syntaxtreeindxclear(&labelnodes); debugannotation_poperr(&c->out->annotations); + + compiler_endcontrolflow(c); return out; } @@ -2884,28 +3242,20 @@ static codeinfo compiler_logical(compiler *c, syntaxtreenode *node, registerindx /** Compile declarations */ static codeinfo compiler_declaration(compiler *c, syntaxtreenode *node, registerindx reqout) { - syntaxtreenode *decnode = node; - syntaxtreenode *typenode = NULL; - - if (node->type==NODE_TYPE) { - typenode=compiler_getnode(c, node->left); - decnode=compiler_getnode(c, node->right); - } - syntaxtreenode *varnode = NULL; syntaxtreenode *lftnode = NULL, *indxnode = NULL; codeinfo right=CODEINFO_EMPTY; - value var=MORPHO_NIL, type=MORPHO_NIL; + value var=MORPHO_NIL, type=compiler_gettypedec(c); registerindx reg; unsigned int ninstructions = 0; - varnode=compiler_getnode(c, decnode->left); + varnode=compiler_getnode(c, node->left); /* Find the symbol */ if (varnode) { - if (varnode->type==NODE_SYMBOL) { + if (varnode->type==NODE_SYMBOL) { // Just a regular symbol var = varnode->content; - } else if (varnode->type==NODE_INDEX) { + } else if (varnode->type==NODE_INDEX) { // It's part of an index assignment lftnode=compiler_getnode(c, varnode->left); if (lftnode && lftnode->type==NODE_SYMBOL) { indxnode=varnode; @@ -2929,16 +3279,16 @@ static codeinfo compiler_declaration(compiler *c, syntaxtreenode *node, register reg=compiler_regtemp(c, REGISTER_UNALLOCATED); } - if (typenode && - compiler_findtype(c, typenode->content, &type)) { - compiler_regsettype(c, reg, type); + if (MORPHO_ISOBJECT(type)) { + // TODO: This should probably be an either/or... if (vloc.returntype==GLOBAL) compiler_setglobaltype(c, vloc.dest, type); + compiler_regsettype(c, reg, type); } /* If this is an array, we must create it */ if (indxnode) { /* Set up a call to the Array() function */ - array=compiler_findbuiltin(c, decnode, ARRAY_CLASSNAME, reqout); + array=compiler_findbuiltin(c, node, ARRAY_CLASSNAME, reqout); ninstructions+=array.ninstructions; // Dimensions @@ -2947,13 +3297,13 @@ static codeinfo compiler_declaration(compiler *c, syntaxtreenode *node, register ninstructions+=indxinfo.ninstructions; // Initializer - if (decnode->right!=SYNTAXTREE_UNCONNECTED) { + if (node->right!=SYNTAXTREE_UNCONNECTED) { iend=compiler_regalloctop(c); - right = compiler_nodetobytecode(c, decnode->right, iend); + right = compiler_nodetobytecode(c, node->right, iend); ninstructions+=right.ninstructions; - right=compiler_movetoregister(c, decnode, right, iend); // Ensure in register + right=compiler_movetoregister(c, node, right, iend); // Ensure in register ninstructions+=right.ninstructions; } @@ -2964,25 +3314,27 @@ static codeinfo compiler_declaration(compiler *c, syntaxtreenode *node, register compiler_regfreetoend(c, istart); if (vloc.returntype==REGISTER && array.dest!=vloc.dest) { // Move to correct register - codeinfo move=compiler_movetoregister(c, decnode, array, vloc.dest); + codeinfo move=compiler_movetoregister(c, node, array, vloc.dest); ninstructions+=move.ninstructions; } else reg=array.dest; - } else if (decnode->right!=SYNTAXTREE_UNCONNECTED) { /* Not an array, but has an initializer */ - right = compiler_nodetobytecode(c, decnode->right, reg); + } else if (node->right!=SYNTAXTREE_UNCONNECTED) { /* Not an array, but has an initializer */ + right = compiler_nodetobytecode(c, node->right, reg); ninstructions+=right.ninstructions; /* Ensure operand is in the desired register */ - right=compiler_movetoregister(c, decnode, right, reg); + right=compiler_movetoregister(c, node, right, reg); ninstructions+=right.ninstructions; - } else { /* Otherwise, we should zero out the register */ - registerindx cnil = compiler_addconstant(c, decnode, MORPHO_NIL, false, false); + } else if (MORPHO_ISOBJECT(type)) { // A typed variable must have an initializer + compiler_error(c, node, COMPILE_NOINITIALIZER, MORPHO_GETCSTRING(var)); + } else { // An untyped variable is simply initialized to nil + registerindx cnil = compiler_addconstant(c, node, MORPHO_NIL, false, false); compiler_addinstruction(c, ENCODE_LONG(OP_LCT, reg, cnil), node); ninstructions++; } if (vloc.returntype!=REGISTER) { - codeinfo mv=compiler_movefromregister(c, decnode, vloc, reg); + codeinfo mv=compiler_movefromregister(c, node, vloc, reg); ninstructions+=mv.ninstructions; compiler_regfreetemp(c, reg); @@ -2994,6 +3346,54 @@ static codeinfo compiler_declaration(compiler *c, syntaxtreenode *node, register return CODEINFO(REGISTER, REGISTER_UNALLOCATED, ninstructions); } +bool _extracttype(compiler *c, syntaxtreenode *node, value *out) { + value type=MORPHO_NIL; + syntaxtreenode *typenode = compiler_getnode(c, node->left); + if (!typenode) UNREACHABLE("Incorrectly formed type node."); + if (typenode->type==NODE_DOT) { + syntaxtreenode *nsnode = compiler_getnode(c, typenode->left); + syntaxtreenode *labelnode = compiler_getnode(c, typenode->right); + + if (!(nsnode && + labelnode && + MORPHO_ISSTRING(nsnode->content) && + MORPHO_ISSTRING(labelnode->content))) UNREACHABLE("Incorrectly formed type namespace node."); + + if (!compiler_isnamespace(c, nsnode->content)) { + compiler_error(c, nsnode, COMPILE_UNKNWNNMSPC, MORPHO_GETCSTRING(nsnode->content)); + return false; + } + + if (!compiler_findclasswithnamespace(c, typenode, nsnode->content, labelnode->content, &type)) { + compiler_error(c, typenode, COMPILE_UNKNWNTYPENMSPC, MORPHO_GETCSTRING(labelnode->content), MORPHO_GETCSTRING(nsnode->content)); + return false; + } + + } else if (MORPHO_ISSTRING(typenode->content)) { + if (!compiler_findtype(c, typenode->content, &type)) { + compiler_error(c, typenode, COMPILE_UNKNWNTYPE, MORPHO_GETCSTRING(typenode->content)); + return false; + } + } else UNREACHABLE("Type node should have string label."); + + *out = type; + return true; +} + +/** Compile typed declarations */ +static codeinfo compiler_typeddeclaration(compiler *c, syntaxtreenode *node, registerindx reqout) { + codeinfo out = CODEINFO_EMPTY; + value type = MORPHO_NIL; + + if (_extracttype(c, node, &type)) { + compiler_settypedec(c, type); + out = compiler_nodetobytecode(c, node->right, reqout); + compiler_settypedec(c, MORPHO_NIL); + } + + return out; +} + /** Compiles an parameter declaration */ static registerindx compiler_functionparameters(compiler *c, syntaxtreeindx indx) { syntaxtreenode *node = compiler_getnode(c, indx); @@ -3006,37 +3406,11 @@ static registerindx compiler_functionparameters(compiler *c, syntaxtreeindx indx case NODE_TYPE: { value type=MORPHO_NIL; - syntaxtreenode *typenode = compiler_getnode(c, node->left); - if (!typenode) UNREACHABLE("Incorrectly formed type node."); - if (typenode->type==NODE_DOT) { - syntaxtreenode *nsnode = compiler_getnode(c, typenode->left); - syntaxtreenode *labelnode = compiler_getnode(c, typenode->right); - - if (!(nsnode && - labelnode && - MORPHO_ISSTRING(nsnode->content) && - MORPHO_ISSTRING(labelnode->content))) UNREACHABLE("Incorrectly formed type namespace node."); - - if (!compiler_isnamespace(c, nsnode->content)) { - compiler_error(c, nsnode, COMPILE_UNKNWNNMSPC, MORPHO_GETCSTRING(nsnode->content)); - return REGISTER_UNALLOCATED; - } - - if (!compiler_findclasswithnamespace(c, typenode, nsnode->content, labelnode->content, &type)) { - compiler_error(c, typenode, COMPILE_SYMBOLNOTDEFINEDNMSPC, MORPHO_GETCSTRING(nsnode->content), MORPHO_GETCSTRING(labelnode->content)); - return REGISTER_UNALLOCATED; - } - - } else if (MORPHO_ISSTRING(typenode->content)) { - if (!compiler_findtype(c, typenode->content, &type)) { - compiler_error(c, node, COMPILE_UNKNWNTYPE, MORPHO_GETCSTRING(typenode->content)); - return REGISTER_UNALLOCATED; - } - } else UNREACHABLE("Type node should have string label."); + if (!_extracttype(c, node, &type)) return REGISTER_UNALLOCATED; registerindx reg = compiler_functionparameters(c, node->right); compiler_regsettype(c, reg, type); - compiler_regsetcurrenttype(c, node, reg, type); + compiler_regsetcurrenttype(c, reg, type); } break; case NODE_ASSIGN: @@ -3123,8 +3497,9 @@ static codeinfo compiler_function(compiler *c, syntaxtreenode *node, registerind /* -- Compile the parameters -- */ compiler_functionparameters(c, node->left); - value signature[func->nargs+1]; + value signature[function_countpositionalargs(func)]; for (int i=0; inargs; i++) compiler_regtype(c, i+1, &signature[i]); + if (function_hasvargs(func)) signature[func->nargs]=MORPHO_NIL; function_setsignature(func, signature); signature_setvarg(&func->sig, function_hasvargs(func)); @@ -3139,12 +3514,16 @@ static codeinfo compiler_function(compiler *c, syntaxtreenode *node, registerind ninstructions+=bodyinfo.ninstructions; /* Add a return instruction if necessary */ - if (ismethod) { // Methods automatically return self unless another argument is specified - compiler_addinstruction(c, ENCODE_DOUBLE(OP_RETURN, 1, 0), node); /* Add a return */ - } else { - compiler_addinstruction(c, ENCODE_BYTE(OP_RETURN), node); /* Add a return */ + if (!compiler_hasreturn(c)) { + if (ismethod) { // Methods automatically return self unless another argument is specified + if (func->klass) compiler_addreturntype(c, MORPHO_OBJECT(func->klass)); + compiler_addinstruction(c, ENCODE_DOUBLE(OP_RETURN, 1, 0), node); /* Add a return */ + } else { + compiler_addreturntype(c, _niltype); + compiler_addinstruction(c, ENCODE_BYTE(OP_RETURN), node); /* Add a return */ + } + ninstructions++; } - ninstructions++; /* Verify if we have any outstanding forward references */ compiler_checkoutstandingforwardreference(c); @@ -3153,6 +3532,9 @@ static codeinfo compiler_function(compiler *c, syntaxtreenode *node, registerind compiler_setinstruction(c, bindx, ENCODE_LONG(OP_B, REGISTER_UNALLOCATED, ninstructions)); ninstructions++; + /* Resolve the return type*/ + compiler_resolvereturntype(c); + /* Restore the old function */ compiler_endfunction(c); @@ -3188,6 +3570,7 @@ static codeinfo compiler_function(compiler *c, syntaxtreenode *node, registerind // Save the register where the closure is to be found compiler_regsetsymbol(c, reg, func->name); compiler_regsettype(c, reg, _closuretype); + compiler_regsetcurrenttype(c, reg, _closuretype); function_setclosure(func, reg); compiler_addinstruction(c, ENCODE_DOUBLE(OP_CLOSURE, reg, (registerindx) closure), node); ninstructions++; @@ -3309,6 +3692,52 @@ static bool compiler_isinvocation(compiler *c, syntaxtreenode *call) { return isinvocation; } +static bool compiler_functionisrecursive(value fn) { + if (MORPHO_ISFUNCTION(fn)) return MORPHO_GETFUNCTION(fn)->isrecursive; + if (MORPHO_ISCLOSURE(fn)) return MORPHO_GETCLOSUREFUNCTION(fn)->isrecursive; + return false; +} + +static bool compiler_metafunctionhasrecursiveimplementation(objectmetafunction *metafunction) { + for (int i=0; ifns.count; i++) { + if (compiler_functionisrecursive(metafunction->fns.data[i])) return true; + } + + return false; +} + +/** Attempt to specialize a constant metafunction call using current argument types. */ +static bool compiler_specializemetafunctioncall(compiler *c, syntaxtreenode *node, codeinfo *func, + instructionindx selectorload, int nargs, value selector, value *rtype) { + if (!MORPHO_ISMETAFUNCTION(selector)) return false; + + objectmetafunction *metafunction = MORPHO_GETMETAFUNCTION(selector); + if (metafunction->state!=METAFUNCTION_FROZEN || + compiler_metafunctionhasrecursiveimplementation(metafunction)) return false; + + value argtypes[nargs]; + for (int i=0; idest+i+1, &type) && compiler_typeisexact(type)) ? type : MORPHO_NIL; + } + + value reduced = MORPHO_NIL; + error err; + error_init(&err); + bool success = metafunction_reduce(metafunction, nargs, argtypes, &err, &reduced); + error_clear(&err); + if (!success) return false; + + registerindx ctarget = compiler_addconstant(c, node, reduced, true, false); + if (ctarget==REGISTER_UNALLOCATED) return false; + + compiler_setinstruction(c, selectorload, ENCODE_LONG(OP_LCT, func->dest, ctarget)); + compiler_getreturntype(c, reduced, rtype); + if (MORPHO_ISOBJECT(reduced)) program_bindobject(c->out, MORPHO_GETOBJECT(reduced)); + + return true; +} + /** Compiles a function call */ static codeinfo compiler_call(compiler *c, syntaxtreenode *node, registerindx reqout) { unsigned int ninstructions=0; @@ -3317,6 +3746,7 @@ static codeinfo compiler_call(compiler *c, syntaxtreenode *node, registerindx re if (compiler_isinvocation(c, node)) { return compiler_invoke(c, node, reqout); } + registerindx top=compiler_regtop(c); compiler_beginargs(c); @@ -3324,9 +3754,13 @@ static codeinfo compiler_call(compiler *c, syntaxtreenode *node, registerindx re // Check if the call is a constructor syntaxtreenode *selnode=compiler_getnode(c, node->left); + // Attempt to infer type for constructors value rtype=MORPHO_NIL; if (selnode->type==NODE_SYMBOL) { // A regular call from a symbol compiler_findtype(c, selnode->content, &rtype); + + objectfunction *current = compiler_getcurrentfunction(c); + if (current && MORPHO_ISEQUAL(current->name, selnode->content)) current->isrecursive=true; } else if (selnode->type==NODE_DOT) { // An constructor in a namespace? syntaxtreenode *nsnode = compiler_getnode(c, selnode->left); syntaxtreenode *snode = compiler_getnode(c, selnode->right); @@ -3337,20 +3771,43 @@ static codeinfo compiler_call(compiler *c, syntaxtreenode *node, registerindx re } } + // Use the requested register for the call if it's on top and isn't typed + registerindx rCallReq = (reqoutleft, (reqoutleft, rCallReq); + + // Attempt to infer return type + bool constantselector = (func.returntype==CONSTANT); + value target=MORPHO_NIL; + if (constantselector) { + target=compiler_getconstant(c, func.dest); + } + if (constantselector && MORPHO_ISNIL(rtype)) { + compiler_getreturntype(c, target, &rtype); + } // Detect possible forward reference if (selnode->type==NODE_SYMBOL && compiler_catch(c, COMPILE_SYMBOLNOTDEFINED)) { syntaxtreenode *symbol=compiler_getnode(c, node->left); func=compiler_addforwardreference(c, symbol, symbol->content); + constantselector=false; + target=MORPHO_NIL; } ninstructions+=func.ninstructions; /* Move selector into a temporary register unless we already have one that's at the top of the stack */ + instructionindx selectorload = -1; if (!compiler_iscodeinfotop(c, func)) { registerindx otop = compiler_regalloctop(c); + if (constantselector) selectorload = compiler_currentinstructionindex(c); func=compiler_movetoregister(c, node, func, otop); ninstructions+=func.ninstructions; } @@ -3374,14 +3831,19 @@ static codeinfo compiler_call(compiler *c, syntaxtreenode *node, registerindx re /* Generate the call instruction */ int nposn=0, nopt=0; compiler_regcountargs(c, func.dest+1, lastarg, &nposn, &nopt); + if (constantselector && nopt==0 && + selectorload>=0) { + compiler_specializemetafunctioncall(c, node, &func, selectorload, nposn, target, &rtype); + } compiler_addinstruction(c, ENCODE(OP_CALL, func.dest, nposn, nopt), node); ninstructions++; /* Free all the registers used for the call */ compiler_regfreetoend(c, func.dest+1); - /* Set the current type of the register */ - compiler_regsetcurrenttype(c, selnode, func.dest, rtype); + /* Set the current type of the destination register */ + compiler_regsetcurrenttype(c, func.dest, rtype); + // TODO: Should we do a typecheck here or leave it to the movetoregister below? /* Move the result to the requested register */ if (reqout!=REGISTER_UNALLOCATED && func.dest!=reqout) { @@ -3394,7 +3856,7 @@ static codeinfo compiler_call(compiler *c, syntaxtreenode *node, registerindx re return CODEINFO(REGISTER, func.dest, ninstructions); } -#include + /* Compiles a method invocation: node | node @@ -3461,6 +3923,14 @@ static codeinfo compiler_invoke(compiler *c, syntaxtreenode *node, registerindx object=compiler_movetoregister(c, selectornode, object, rObj); ninstructions+=object.ninstructions; + // Attempt to infer return type + value otype=MORPHO_NIL, rtype=MORPHO_NIL; + if (compiler_regcurrenttype(c, rObj, &otype) && + !MORPHO_ISNIL(otype) && + MORPHO_ISSTRING(methodnode->content)) { + compiler_getmethodreturntype(c, otype, methodnode->content, &rtype); + } + // Compile the arguments codeinfo args = CODEINFO_EMPTY; if (node->right!=SYNTAXTREE_UNCONNECTED) args=compiler_nodetobytecode(c, node->right, REGISTER_UNALLOCATED); @@ -3477,7 +3947,7 @@ static codeinfo compiler_invoke(compiler *c, syntaxtreenode *node, registerindx compiler_endargs(c); - // Generate the call instruction + // Generate the invoke instruction int nposn=0, nopt=0; compiler_regcountargs(c, object.dest+1, lastarg, &nposn, &nopt); compiler_addinstruction(c, ENCODE(OP_INVOKE, rSel, nposn, nopt), node); @@ -3487,10 +3957,14 @@ static codeinfo compiler_invoke(compiler *c, syntaxtreenode *node, registerindx compiler_regfreetemp(c, rSel); compiler_regfreetoend(c, rObj+1); + /* Set the current type of the register */ + compiler_regsetcurrenttype(c, rObj, rtype); + // Move the result to the requested register if (reqout!=REGISTER_UNALLOCATED && object.dest!=reqout) { - compiler_addinstruction(c, ENCODE_DOUBLE(OP_MOV, reqout, rObj), node); - ninstructions++; + codeinfo cmov=compiler_movetoregister(c, node, object, reqout); + ninstructions+=cmov.ninstructions; + compiler_regfreetemp(c, rObj); object.dest=reqout; } @@ -3517,20 +3991,31 @@ static codeinfo compiler_return(compiler *c, syntaxtreenode *node, registerindx ninstructions+=left.ninstructions; } + compiler_addreturntypefromregister(c, left.dest); compiler_addinstruction(c, ENCODE_DOUBLE(OP_RETURN, 1, left.dest), node); ninstructions++; } compiler_releaseoperand(c, left); } else { + objectclass *klass = compiler_getcurrentclass(c); /* Methods return self unless a return value is specified */ - if (compiler_getcurrentclass(c)) { + if (klass) { + compiler_addreturntype(c, MORPHO_OBJECT(klass)); compiler_addinstruction(c, ENCODE_DOUBLE(OP_RETURN, 1, 0), node); /* Add a return */ } else { + compiler_addreturntype(c, _niltype); compiler_addinstruction(c, ENCODE_DOUBLE(OP_RETURN, 0, 0), node); } ninstructions++; } + /* If we generated a return instruction and we are not in a control flow statement, + set the unconditional return flag */ + if (ninstructions>0 && + !compiler_incontrolflow(c)) { + compiler_sethasreturn(c); + } + return CODEINFO(REGISTER, REGISTER_UNALLOCATED, ninstructions); } @@ -3705,7 +4190,7 @@ static codeinfo compiler_class(compiler *c, syntaxtreenode *node, registerindx r if (superclass!=klass) { if (!klass->superclass) klass->superclass=superclass; // Only the first class is the super class, all others are mixins. compiler_addparent(c, klass, superclass); - dictionary_copy(&superclass->methods, &klass->methods); + dictionary_copy(&superclass->methods, &klass->methods); // TODO: Need clearer inheritance rule for metamethods } else { compiler_error(c, snode, COMPILE_CLASSINHERITSELF); } @@ -3818,8 +4303,8 @@ static codeinfo compiler_symbol(compiler *c, syntaxtreenode *node, registerindx !MORPHO_ISEQUAL(type, _closuretype)) { return ret; } - - /* Is it a reference to a function? */ + + /* Is it (unambiguously) a reference to a function? */ if (compiler_resolvefunctionref(c, node, node->content, &ret)) { return ret; } @@ -3994,7 +4479,7 @@ static codeinfo compiler_assign(compiler *c, syntaxtreenode *node, registerindx /* Compiles property lookup */ static codeinfo compiler_property(compiler *c, syntaxtreenode *node, registerindx reqout) { codeinfo left = CODEINFO_EMPTY, prop = CODEINFO_EMPTY; - registerindx out = compiler_regtemp(c, reqout); + registerindx rout = compiler_regtemp(c, reqout); /* The left hand side should evaluate to the object in question */ left = compiler_nodetobytecode(c, node->left, REGISTER_UNALLOCATED); @@ -4015,14 +4500,23 @@ static codeinfo compiler_property(compiler *c, syntaxtreenode *node, registerind compiler_error(c, selector, COMPILE_PROPERTYNAMERQD); } - if (out !=REGISTER_UNALLOCATED) { - compiler_addinstruction(c, ENCODE(OP_LPR, out, left.dest, prop.dest), node); - ninstructions++; + codeinfo out=CODEINFO(REGISTER, rout, ninstructions); + + if (rout!=REGISTER_UNALLOCATED) { + compiler_addinstruction(c, ENCODE(OP_LPR, rout, left.dest, prop.dest), node); + out.ninstructions++; + + value type=MORPHO_NIL, symbol=MORPHO_NIL; + if (compiler_regtype(c, rout, &type) && + compiler_regsymbol(c, rout, &symbol)) { + compiler_regtypecheck(c, node, rout, type, symbol, &out); + } + compiler_releaseoperand(c, left); if (CODEINFO_ISREGISTER(prop)) compiler_releaseoperand(c, prop); } - return CODEINFO(REGISTER, out, ninstructions); + return out; } /** Compiles the dot operator, which may be property lookup or a method call */ @@ -4311,6 +4805,16 @@ static codeinfo compiler_import(compiler *c, syntaxtreenode *node, registerindx goto compiler_import_cleanup; } + /* Change working directory to new file for duration of import compilation */ + varray_char wrkdir; + varray_charinit(&wrkdir); + file_getworkingdirectory(&wrkdir); + varray_char fpath; + varray_charinit(&fpath); + varray_charadd(&fpath, wrkdir.data, wrkdir.count-1); + varray_charadd(&fpath, fname, (int) strlen(fname)); + file_setworkingdirectory(fpath.data); + /* Remember the initial position of the code */ start=c->out->code.count; @@ -4347,6 +4851,11 @@ static codeinfo compiler_import(compiler *c, syntaxtreenode *node, registerindx debugannotation_setmodule(&c->out->annotations, compiler_getmodule(c)); end=c->out->code.count; + + /* Restore old working directory */ + file_setworkingdirectory(wrkdir.data); + varray_charclear(&wrkdir); + varray_charclear(&fpath); compiler_clear(&cc); varray_charclear(&src); @@ -4469,6 +4978,8 @@ bool morpho_compile(char *in, compiler *c, bool opt, error *err) { if (success) { if (opt && optimizer) (*optimizer) (c->out); + + if (!metafunction_finalizelist(out->boundlist, err)) return false; c->line=c->lex.line+1; // Update the line counter if compilation was a success; assumes a new line every time morpho_compile is called. } @@ -4512,7 +5023,18 @@ void compile_initialize(void) { _selfsymbol=builtin_internsymbolascstring("self"); /** Types we need to refer to */ - _closuretype = MORPHO_OBJECT(object_getveneerclass(OBJECT_CLOSURE)); + _closuretype = builtin_findclassfromcstring(CLOSURE_CLASSNAME); + _stringtype = builtin_findclassfromcstring(STRING_CLASSNAME); + _dicttype = builtin_findclassfromcstring(DICTIONARY_CLASSNAME); + _listtype = builtin_findclassfromcstring(LIST_CLASSNAME); + _rangetype = builtin_findclassfromcstring(RANGE_CLASSNAME); + _tupletype = builtin_findclassfromcstring(TUPLE_CLASSNAME); + _complextype = builtin_findclassfromcstring(COMPLEX_CLASSNAME); + + _inttype = builtin_findclassfromcstring(INT_CLASSNAME); + _floattype = builtin_findclassfromcstring(FLOAT_CLASSNAME); + _booltype = builtin_findclassfromcstring(BOOL_CLASSNAME); + _niltype = builtin_findclassfromcstring(NIL_CLASSNAME); optimizer = NULL; @@ -4531,7 +5053,6 @@ void compile_initialize(void) { morpho_defineerror(COMPILE_CLASSINHERITSELF, ERROR_COMPILE, COMPILE_CLASSINHERITSELF_MSG); morpho_defineerror(COMPILE_TOOMANYARGS, ERROR_COMPILE, COMPILE_TOOMANYARGS_MSG); morpho_defineerror(COMPILE_TOOMANYPARAMS, ERROR_COMPILE, COMPILE_TOOMANYPARAMS_MSG); - morpho_defineerror(COMPILE_ISOLATEDSUPER, ERROR_COMPILE, COMPILE_ISOLATEDSUPER_MSG); morpho_defineerror(COMPILE_VARALREADYDECLARED, ERROR_COMPILE, COMPILE_VARALREADYDECLARED_MSG); morpho_defineerror(COMPILE_FILENOTFOUND, ERROR_COMPILE, COMPILE_FILENOTFOUND_MSG); morpho_defineerror(COMPILE_MODULENOTFOUND, ERROR_COMPILE, COMPILE_MODULENOTFOUND_MSG); @@ -4547,6 +5068,7 @@ void compile_initialize(void) { morpho_defineerror(COMPILE_INVLDLBL, ERROR_COMPILE, COMPILE_INVLDLBL_MSG); morpho_defineerror(COMPILE_MSSNGINDX, ERROR_COMPILE, COMPILE_MSSNGINDX_MSG); morpho_defineerror(COMPILE_TYPEVIOLATION, ERROR_COMPILE, COMPILE_TYPEVIOLATION_MSG); + morpho_defineerror(COMPILE_NOINITIALIZER, ERROR_COMPILE, COMPILE_NOINITIALIZER_MSG); morpho_defineerror(COMPILE_UNKNWNTYPE, ERROR_COMPILE, COMPILE_UNKNWNTYPE_MSG); morpho_defineerror(COMPILE_UNKNWNNMSPC, ERROR_COMPILE, COMPILE_UNKNWNNMSPC_MSG); morpho_defineerror(COMPILE_UNKNWNTYPENMSPC, ERROR_COMPILE, COMPILE_UNKNWNTYPENMSPC_MSG); diff --git a/src/core/compile.h b/src/core/compile.h index 6f1737164..ad945ddb3 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -60,9 +60,6 @@ #define COMPILE_TOOMANYPARAMS "TooMnyPrm" #define COMPILE_TOOMANYPARAMS_MSG "Too many parameters." -#define COMPILE_ISOLATEDSUPER "IsoSpr" -#define COMPILE_ISOLATEDSUPER_MSG "Expect '.' after 'super'." - #define COMPILE_VARALREADYDECLARED "VblDcl" #define COMPILE_VARALREADYDECLARED_MSG "Variable with this name already declared in this scope." @@ -108,6 +105,9 @@ #define COMPILE_TYPEVIOLATION "TypeErr" #define COMPILE_TYPEVIOLATION_MSG "Type violation: Attempting to assign type %s to %s variable %s." +#define COMPILE_NOINITIALIZER "MssngIntlzr" +#define COMPILE_NOINITIALIZER_MSG "Missing initializer for typed variable %s." + #define COMPILE_UNKNWNTYPE "UnknwnType" #define COMPILE_UNKNWNTYPE_MSG "Unknown type '%s'." @@ -238,11 +238,15 @@ typedef struct { varray_upvalue upvalues; varray_forwardreference forwardref; varray_functionref functionref; /* Functions visible within this state */ + dictionary returntypes; /** Possible return types */ registerindx varg; unsigned int nreg; /* Largest number of registers used */ unsigned int scopedepth; unsigned int loopdepth; /* Count number of nesting depths of a loop */ + unsigned int cfdepth; /* Count depth inside control flow; allows us to identify where returns are */ bool inargs; /* Set while compiling function calls to ensure allocations are at the top of the stack */ + bool hasreturn; /* Set if the compiling function has an unconditional return */ + value typedec; /* Set to the current type of a type declaration */ //unsigned int nposn; /* Number of positional args recorded in latest call */ //unsigned int nopt; /* Number of optional args recorded in latest call */ } functionstate; diff --git a/src/core/core.h b/src/core/core.h index 54e0726dd..02d4a3c54 100644 --- a/src/core/core.h +++ b/src/core/core.h @@ -10,7 +10,13 @@ #include #include +/** Forward declarations of key types */ +struct sprogram; +struct scompiler; + typedef struct svm vm; +typedef struct sprogram program; +typedef struct scompiler compiler; #include "error.h" #include "random.h" @@ -185,6 +191,8 @@ typedef struct { /** Varrays of vms */ DECLARE_VARRAY(vm, vm*) +typedef enum { VM_RUNNING, VM_BIND, VM_INGC } vmstatus; + /** @brief A Morpho virtual machine and its current state */ struct svm { program *current; /** The current program being executed */ @@ -214,8 +222,8 @@ struct svm { #ifdef MORPHO_PROFILER profiler *profiler; - enum { VM_RUNNING, VM_INGC } status; #endif + vmstatus status; objectupvalue *openupvalues; /** Linked list of open upvalues */ diff --git a/src/core/gc.c b/src/core/gc.c index 0e3ac4f90..2e6361504 100644 --- a/src/core/gc.c +++ b/src/core/gc.c @@ -48,7 +48,7 @@ void vm_graylistadd(graylist *g, object *obj) { } /* ********************************************************************** - * Garbage collector + * Marking phase * ********************************************************************** */ /** Recalculates the size of bound objects to the VM */ @@ -60,9 +60,16 @@ size_t vm_gcrecalculatesize(vm *v) { return size; } +void vm_bindobjectwithoutcollect(vm *v, value obj); + /** Marks an object as reachable */ void vm_gcmarkobject(vm *v, object *obj) { - if (!obj || obj->status!=OBJECT_ISUNMARKED) return; + if (!obj) return; + if (v->status==VM_BIND) { // Bind object rather than mark + vm_bindobjectwithoutcollect(v, MORPHO_OBJECT(obj)); + return; + } + if (obj->status!=OBJECT_ISUNMARKED) return; #ifdef MORPHO_DEBUG_LOGGARBAGECOLLECTOR morpho_printf(v, "Marking %p ", obj); @@ -76,9 +83,7 @@ void vm_gcmarkobject(vm *v, object *obj) { /** Marks a value as reachable */ void vm_gcmarkvalue(vm *v, value val) { - if (MORPHO_ISOBJECT(val)) { - vm_gcmarkobject(v, MORPHO_GETOBJECT(val)); - } + if (MORPHO_ISOBJECT(val)) vm_gcmarkobject(v, MORPHO_GETOBJECT(val)); } /** Marks all entries in a dictionary */ @@ -123,14 +128,6 @@ void vm_gcmarkroots(vm *v) { #endif value *stacktop = v->stack.data+v->fp->roffset+v->fp->function->nregs-1; - /* Find the largest stack position currently in play */ - /*for (callframe *f=v->frame; ffp; f++) { - value *ftop = v->stack.data+f->roffset+f->function->nregs-1; - if (ftop>stacktop) stacktop=ftop; - }*/ - - //debug_showstack(v); - for (value *s=stacktop; s>=v->stack.data; s--) { if (MORPHO_ISOBJECT(*s)) vm_gcmarkvalue(v, *s); } @@ -249,15 +246,13 @@ void vm_collectgarbage(vm *v) { if (!vc) return; if (vc->parent) return; // Don't garbage collect in subkernels - -#ifdef MORPHO_PROFILER + vmstatus oldstatus = vc->status; // Preserve status vc->status=VM_INGC; -#endif if (vc && vc->bound>0) { size_t init=vc->bound; #ifdef MORPHO_DEBUG_LOGGARBAGECOLLECTOR - morpho_printf(v, "--- begin garbage collection ---\n"); + morpho_printf(vc, "--- begin garbage collection ---\n"); #endif vm_gcmarkroots(vc); vm_gctrace(vc); @@ -265,23 +260,21 @@ void vm_collectgarbage(vm *v) { if (vc->bound>init) { #ifdef MORPHO_DEBUG_GCSIZETRACKING - morpho_printf(v, "GC collected %ld bytes (from %zu to %zu) next at %zu.\n", init-vc->bound, init, vc->bound, vc->bound*MORPHO_GCGROWTHFACTOR); + morpho_printf(vc, "GC collected %ld bytes (from %zu to %zu) next at %zu.\n", init-vc->bound, init, vc->bound, vc->bound*MORPHO_GCGROWTHFACTOR); UNREACHABLE("VM bound object size < 0"); #else // This catch has been put in to prevent the garbarge collector from completely seizing up. - vc->bound=vm_gcrecalculatesize(v); + vc->bound=vm_gcrecalculatesize(vc); #endif } vc->nextgc=vc->bound*MORPHO_GCGROWTHFACTOR; #ifdef MORPHO_DEBUG_LOGGARBAGECOLLECTOR - morpho_printf(v, "--- end garbage collection ---\n"); - if (vc) morpho_printf(v, " collected %ld bytes (from %zu to %zu) next at %zu.\n", init-vc->bound, init, vc->bound, vc->nextgc); + morpho_printf(vc, "--- end garbage collection ---\n"); + if (vc) morpho_printf(vc, " collected %ld bytes (from %zu to %zu) next at %zu.\n", init-vc->bound, init, vc->bound, vc->nextgc); #endif } -#ifdef MORPHO_PROFILER - vc->status=VM_RUNNING; -#endif + vc->status=oldstatus; } diff --git a/src/core/opcodes.h b/src/core/opcodes.h index 2fb5f6d19..e02dca6bb 100644 --- a/src/core/opcodes.h +++ b/src/core/opcodes.h @@ -114,6 +114,9 @@ OPCODE(CAT) /** Print the cotents of a register */ OPCODE(PRINT) +/** Type check the contents of a register */ +OPCODE(TYPECHECK) + /** Raise error */ //OPCODE(RAISE) diff --git a/src/core/vm.c b/src/core/vm.c index 6e3d4f2aa..d2f0d1454 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -15,6 +15,7 @@ #include "profile.h" #include "resources.h" #include "extensions.h" +#include "help.h" value initselector = MORPHO_NIL; value indexselector = MORPHO_NIL; @@ -39,7 +40,7 @@ dictionary sizecheck; #endif /* ********************************************************************** -* VM objects +* VM initialization and finalization * ********************************************************************** */ vm *globalvm=NULL; @@ -68,8 +69,8 @@ static void vm_init(vm *v) { v->errfp=NULL; #ifdef MORPHO_PROFILER v->profiler=NULL; - v->status=VM_RUNNING; #endif + v->status=VM_RUNNING; v->parent=NULL; varray_vminit(&v->subkernels); @@ -156,10 +157,90 @@ void vm_freeobjects(vm *v) { } /* ********************************************************************** -* Binding and unbinding objects to the VM +* Garbage collection * ********************************************************************** */ -/** Unbinds an object from a VM. */ +/** @brief Checks whether the gc should run. */ +static bool vm_shouldgc(vm *v) { + return v->bound>v->nextgc; +} + +/** @brief Runs the gc if necessary. */ +static void vm_checkgc(vm *v) { +#ifdef MORPHO_DEBUG_STRESSGARBAGECOLLECTOR + vm_collectgarbage(v); +#else + if (vm_shouldgc(v)) vm_collectgarbage(v); +#endif +} + +/** @brief Binds an object to a Virtual Machine without triggering garbage collection. + * @param v the virtual machine + * @param obj object to bind + * @warning: For internal use only; e.g. when the internal state of the VM is not consistent and calling the GC could cause a sigsev. */ +void vm_bindobjectwithoutcollect(vm *v, value obj) { + if (!MORPHO_ISOBJECT(obj)) return; + object *ob = MORPHO_GETOBJECT(obj); + +#ifdef MORPHO_DEBUG_LOGGARBAGECOLLECTOR + morpho_printf(v, "Binding object %p.\n", ob); +#endif + + if (ob->status!=OBJECT_ISUNMANAGED) return; + ob->status=OBJECT_ISUNMARKED; + ob->next=v->objects; + v->objects=ob; + size_t size=object_size(ob); + v->bound+=size; + +#ifdef MORPHO_DEBUG_GCSIZETRACKING + dictionary_insert(&sizecheck, obj, MORPHO_INTEGER(size)); +#endif +} + +/** @brief Binds an object to a Virtual Machine recursively. + * @param v the virtual machine + * @param obj object to bind; searches contents through markfn and binds anything that is enclosed */ +void vm_bindrecursive(vm *v, value obj) { + if (!MORPHO_ISOBJECT(obj)) return; + object *ob = MORPHO_GETOBJECT(obj); + if (ob->status != OBJECT_ISUNMANAGED) return; // Don't recurse into an already managed object. + vmstatus old = v->status; // Preserve status + v->status = VM_BIND; // Enter bind mode + + object *oldobjects = v->objects; // Remember the previous head of the managed list. + object *boundary = oldobjects; // Stop at the previous head of the managed list. + + vm_bindobjectwithoutcollect(v, obj); // Bind first object + + do { + object *head = v->objects; + + // Loop over newly added objects, calling their markfn which causes children to be bound. + for (object *current = head; current != boundary; current = current->next) { + current->status = OBJECT_ISMARKED; // Ensure newly added objects are retained at least across this gc run. + objecttypedefn *defn = object_getdefn(current); + if (defn->markfn) defn->markfn(current, v); + } + + boundary = head; + } while (v->objects != boundary); // Did we add any new objects? + + v->status=old; // Restore status + + vm_checkgc(v); +} + +/** @brief Binds an object to a Virtual Machine. + * @details Any object created during execution should be bound to a VM; this object is then managed by the garbage collector. + * @param v the virtual machine + * @param obj object to bind */ +static void vm_bindobject(vm *v, value obj) { + vm_bindobjectwithoutcollect(v, obj); + vm_checkgc(v); +} + +/** @brief Unbinds an object from a VM. */ void vm_unbindobject(vm *v, value obj) { object *ob=MORPHO_GETOBJECT(obj); @@ -170,56 +251,105 @@ void vm_unbindobject(vm *v, value obj) { if (e->next==ob) { e->next=ob->next; break; } } } - // Correct estimate of bound size. - if (MORPHO_ISGARBAGECOLLECTED(obj)) { + + if (MORPHO_ISGARBAGECOLLECTED(obj)) { // Correct estimate of bound size. v->bound-=object_size(ob); ob->status=OBJECT_ISUNMANAGED; } } -/** @brief Binds an object to a Virtual Machine. - * @details Any object created during execution should be bound to a VM; this object is then managed by the garbage collector. +/** @brief Temporarily retain objects across multiple reentrant calls to the VM. * @param v the virtual machine - * @param obj object to bind */ -static void vm_bindobject(vm *v, value obj) { - object *ob = MORPHO_GETOBJECT(obj); - ob->status=OBJECT_ISUNMARKED; - ob->next=v->objects; - v->objects=ob; - size_t size=object_size(ob); -#ifdef MORPHO_DEBUG_GCSIZETRACKING - dictionary_insert(&sizecheck, obj, MORPHO_INTEGER(size)); -#endif + * @param nobj number of objects to retain + * @param obj objects to retain + * @returns an integer handle to pass to releaseobjects */ +int morpho_retainobjects(vm *v, int nobj, value *obj) { + int gcount=v->retain.count; + varray_valueadd(&v->retain, obj, nobj); + return gcount; +} - v->bound+=size; +/** @brief Release objects temporarily retained by the VM. + * @param v the virtual machine + * @param handle a handle returned by morpho_retainobjects. */ +void morpho_releaseobjects(vm *v, int handle) { + if (handle>=0) v->retain.count=handle; +} -#ifdef MORPHO_DEBUG_STRESSGARBAGECOLLECTOR - vm_collectgarbage(v); -#else - if (v->bound>v->nextgc) vm_collectgarbage(v); +/** @brief Inform the VM that the size of an object has changed + * @param v the virtual machine + * @param obj the object to resize + * @param oldsize old size + * @param newsize new size */ +void morpho_resizeobject(vm *v, object *obj, size_t oldsize, size_t newsize) { +#ifdef MORPHO_DEBUG_GCSIZETRACKING + dictionary_insert(&sizecheck, MORPHO_OBJECT(obj), MORPHO_INTEGER(newsize)); #endif + if (!MORPHO_ISGARBAGECOLLECTED(MORPHO_OBJECT(obj))) return; + v->bound-=oldsize; + v->bound+=newsize; } -/** @brief Binds an object to a Virtual Machine without garbage collection. +/** @brief Binds a set of objects to a Virtual Machine; public interface. * @details Any object created during execution should be bound to a VM; this object is then managed by the garbage collector. * @param v the virtual machine - * @param obj object to bind - * @warning: This should only be used in circumstances where the internal state of the VM is not consistent (i.e. calling the GC could cause a sigsev) */ -static void vm_bindobjectwithoutcollect(vm *v, value obj) { - object *ob = MORPHO_GETOBJECT(obj); - ob->status=OBJECT_ISUNMARKED; - ob->next=v->objects; - v->objects=ob; - size_t size=object_size(ob); -#ifdef MORPHO_DEBUG_GCSIZETRACKING - dictionary_insert(&sizecheck, obj, MORPHO_INTEGER(size)); + * @param obj objects to bind */ +void morpho_bindobjects(vm *v, int nobj, value *obj) { + for (unsigned int i=0; ibound>v->nextgc) #endif + { + int handle=morpho_retainobjects(v, nobj, obj); + vm_collectgarbage(v); + morpho_releaseobjects(v, handle); + } +} - v->bound+=size; +/** @brief Binds an object and any children to the virtual machine. */ +void morpho_bindrecursive(vm *v, value obj) { + vm_bindrecursive(v, obj); +} + +/** @brief Convenience function to wrap a single object into a value and bind to the VM + * @param v VM to use + * @param out Object to wrap + * @returns object wrapped in a value, or MORPHO_NIL if obj is NULL + * Also raises ERROR_ALLOCATIONFAILED if passed a null pointer */ +value morpho_wrapandbind(vm *v, object *obj) { + value out = MORPHO_NIL; + if (obj) { + out=MORPHO_OBJECT(obj); + morpho_bindobjects(v, 1, &out); + } else if (!morpho_checkerror(&v->err)) morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + return out; +} + +/** @brief Convenience function to wrap a single object into a value and bind to the VM + * @param v VM to use + * @param out Object to wrap + * @returns object wrapped in a value, or MORPHO_NIL if obj is NULL + * Also raises ERROR_ALLOCATIONFAILED if passed a null pointer */ +value morpho_wrapandbindrecursive(vm *v, object *obj) { + value out = MORPHO_NIL; + if (obj) { + out=MORPHO_OBJECT(obj); + vm_bindrecursive(v, out); + } else if (!morpho_checkerror(&v->err)) morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + return out; +} + +/** @brief Checks if an object is managed by the garbage collector + * @param obj the object to check + * @returns true if it is managed, false otherwise */ +bool morpho_ismanagedobject(object *obj) { + return MORPHO_ISGARBAGECOLLECTED(MORPHO_OBJECT(obj)); } /* ********************************************************************** -* Virtual machine +* Errors * ********************************************************************** */ /** @brief Raises a runtime error @@ -265,8 +395,66 @@ void vm_throwOpError(vm *v, ptrdiff_t iindx, errorid id, char* op, value left, v vm_runtimeerror(v,iindx,id,op,left_buffer.data,right_buffer.data); varray_charclear(&left_buffer); varray_charclear(&right_buffer); +} + + +/** Returns a VM's error block */ +error *morpho_geterror(vm *v) { + return &v->err; +} + +/** @brief Raises an error described by an error structure + * @param v the virtual machine + * @param err error to raise */ +void morpho_error(vm *v, error *err) { + if (err->cat!=ERROR_WARNING) { // Errors of category ERROR_WARNING are always raised as warnings + v->err = *err; + } else morpho_warning(v, err); +} + +/** @brief Raises an warning described by an error structure */ +void morpho_warning(vm *v, error *err) { + if (v->warningfn) { + (v->warningfn) (v, v->warningref, err); + } else { + fprintf(stderr, "Warning [%s]: %s\n", err->id, err->msg); } +} +/** @brief Raise a runtime error given an id + * @param v the virtual machine + * @param id error id + * @param ... additional data for sprintf. */ +void morpho_runtimeerror(vm *v, errorid id, ...) { + va_list args; + error err; + error_init(&err); + + va_start(args, id); + morpho_writeerrorwithidvalist(&err, id, NULL, ERROR_POSNUNIDENTIFIABLE, ERROR_POSNUNIDENTIFIABLE, args); + va_end(args); + + morpho_error(v, &err); + error_clear(&err); +} + +/** @brief Raise a runtime warning given an id */ +void morpho_runtimewarning(vm *v, errorid id, ...) { + va_list args; + error err; + error_init(&err); + + va_start(args, id); + morpho_writeerrorwithidvalist(&err, id, NULL, ERROR_POSNUNIDENTIFIABLE, ERROR_POSNUNIDENTIFIABLE, args); + va_end(args); + + morpho_warning(v, &err); + error_clear(&err); +} + +/* ********************************************************************** +* Upvalues +* ********************************************************************** */ /** @brief Captures an upvalue * @param v the virtual machine @@ -316,6 +504,10 @@ static inline void vm_closeupvalues(vm *v, value *reg) { } } +/* ********************************************************************** +* VM helper functions +* ********************************************************************** */ + /** Check if we should break at a given pc */ bool vm_shouldbreakatpc(vm *v, instruction *pc) { if (!v->debug) return false; @@ -382,6 +574,11 @@ static inline void vm_expandstack(vm *v, value **reg, unsigned int n) { v->stack.count+=n; } +/** Recovers the number of optional arguments */ +int vm_getoptionalargs(vm *v) { + return v->fp->nopt; +} + /** Process optional args */ bool vm_optargs(vm *v, ptrdiff_t iindx, objectfunction *func, unsigned int nopt, value *args, value *outreg) { unsigned int nfopt = func->opt.count; @@ -577,16 +774,20 @@ static inline bool vm_invoke(vm *v, value obj, value method, int nargs, value *a for (unsigned int i=0; ifunction) (v, nargs, sargs); return true; - } + } else return morpho_invoke(v, obj, ifunc, nargs, args, out); } } } return false; } -/** Recovers the number of optional arguments */ -int vm_getoptionalargs(vm *v) { - return v->fp->nopt; +/** Performs a type check operation + * @param[in] v - the VM in use + * @param[in] val - value to check + * @param[in] match - type to match + * @returns true on success, false otherwise */ +static inline bool vm_typecheck(vm *v, value val, value match) { + return value_istype(val, match); } /** @brief Executes a sequence of code @@ -1159,9 +1360,9 @@ bool morpho_interpret(vm *v, value *rstart, instructionindx istart) { } } else { /* Check if the operand has a veneer class */ - objectclass *klass; + objectclass *klass=NULL; if (MORPHO_ISOBJECT(left)) klass = object_getveneerclass(MORPHO_GETOBJECTTYPE(left)); - else klass = value_getveneerclass(left); + else if (!MORPHO_ISNIL(left)) klass = value_getveneerclass(left); if (klass) { value ifunc; @@ -1339,9 +1540,9 @@ bool morpho_interpret(vm *v, value *rstart, instructionindx istart) { } } else { /* Check for veneer class */ - objectclass *klass; + objectclass *klass=NULL; if (MORPHO_ISOBJECT(left)) klass = object_getveneerclass(MORPHO_GETOBJECTTYPE(left)); - else klass = value_getveneerclass(left); + else if (!MORPHO_ISNIL(left)) klass = value_getveneerclass(left); if (klass) { value ifunc; @@ -1476,6 +1677,23 @@ bool morpho_interpret(vm *v, value *rstart, instructionindx istart) { morpho_printf(v, "\n"); DISPATCH(); + CASE_CODE(TYPECHECK): + a=DECODE_A(bc); b=DECODE_Bx(bc); + + if (!vm_typecheck(v, reg[a], v->konst[b])) { + value type; + value_type(reg[a], &type); + char *typename = MORPHO_NILSTRING; + if (MORPHO_ISCLASS(type)) typename = MORPHO_GETCSTRING(MORPHO_GETCLASS(type)->name); + + + VERROR(VM_TYPECHK, + typename, + MORPHO_GETCSTRING(MORPHO_GETCLASS(v->konst[b])->name)); + } + + DISPATCH(); + CASE_CODE(BREAK): if (v->debug) { if (vm_shouldbreakatpc(v, pc) || @@ -1592,7 +1810,7 @@ bool morpho_interpret(vm *v, value *rstart, instructionindx istart) { } /* ********************************************************************** -* VM public interfaces +* VM creation and configuration * ********************************************************************** */ /** Creates a new virtual machine */ @@ -1634,148 +1852,6 @@ void morpho_setdebuggerfn(vm *v, morphodebuggerfn debuggerfn, void *ref) { v->debuggerref=ref; } -/** Returns a VM's error block */ -error *morpho_geterror(vm *v) { - return &v->err; -} - -/** @brief Raises an error described by an error structure - * @param v the virtual machine - * @param err error to raise */ -void morpho_error(vm *v, error *err) { - if (err->cat!=ERROR_WARNING) { // Errors of category ERROR_WARNING are always raised as warnings - v->err = *err; - } else morpho_warning(v, err); -} - -/** @brief Raises an warning described by an error structure */ -void morpho_warning(vm *v, error *err) { - if (v->warningfn) { - (v->warningfn) (v, v->warningref, err); - } else { - fprintf(stderr, "Warning [%s]: %s\n", err->id, err->msg); - } -} - -/** @brief Raise a runtime error given an id - * @param v the virtual machine - * @param id error id - * @param ... additional data for sprintf. */ -void morpho_runtimeerror(vm *v, errorid id, ...) { - va_list args; - error err; - error_init(&err); - - va_start(args, id); - morpho_writeerrorwithidvalist(&err, id, NULL, ERROR_POSNUNIDENTIFIABLE, ERROR_POSNUNIDENTIFIABLE, args); - va_end(args); - - morpho_error(v, &err); - error_clear(&err); -} - -/** @brief Raise a runtime warning given an id */ -void morpho_runtimewarning(vm *v, errorid id, ...) { - va_list args; - error err; - error_init(&err); - - va_start(args, id); - morpho_writeerrorwithidvalist(&err, id, NULL, ERROR_POSNUNIDENTIFIABLE, ERROR_POSNUNIDENTIFIABLE, args); - va_end(args); - - morpho_warning(v, &err); - error_clear(&err); -} - -/** @brief Binds a set of objects to a Virtual Machine; public interface. - * @details Any object created during execution should be bound to a VM; this object is then managed by the garbage collector. - * @param v the virtual machine - * @param obj objects to bind */ -void morpho_bindobjects(vm *v, int nobj, value *obj) { - /* Now bind the new objects in. */ - for (unsigned int i=0; istatusstatus=OBJECT_ISUNMARKED; - ob->next=v->objects; - v->objects=ob; - size_t size=object_size(ob); - v->bound+=size; -#ifdef MORPHO_DEBUG_GCSIZETRACKING - dictionary_insert(&sizecheck, obj[i], MORPHO_INTEGER(size)); -#endif - } - } - - /* Check if size triggers garbage collection */ -#ifndef MORPHO_DEBUG_STRESSGARBAGECOLLECTOR - if (v->bound>v->nextgc) -#endif - { - int handle=morpho_retainobjects(v, nobj, obj); - - vm_collectgarbage(v); - - morpho_releaseobjects(v, handle); - } -} - -/** @brief Convenience function to wrap a single object into a value and bind to the VM - * @param v VM to use - * @param out Object to wrap - * @returns object wrapped in a value, or MORPHO_NIL if obj is NULL */ -value morpho_wrapandbind(vm *v, object *obj) { - value out = MORPHO_NIL; - if (obj) { - out=MORPHO_OBJECT(obj); - morpho_bindobjects(v, 1, &out); - } - return out; -} - -/** @brief Temporarily retain objects across multiple reentrant calls to the VM. - * @param v the virtual machine - * @param nobj number of objects to retain - * @param obj objects to retain - * @returns an integer handle to pass to releaseobjects */ -int morpho_retainobjects(vm *v, int nobj, value *obj) { - int gcount=v->retain.count; - varray_valueadd(&v->retain, obj, nobj); - return gcount; -} - -/** @brief Release objects temporarily retained by the VM. - * @param v the virtual machine - * @param handle a handle returned by morpho_retainobjects. */ -void morpho_releaseobjects(vm *v, int handle) { - if (handle>=0) v->retain.count=handle; -} - -/** @brief Inform the VM that the size of an object has changed - * @param v the virtual machine - * @param obj the object to resize - * @param oldsize old size - * @param newsize new size - */ -void morpho_resizeobject(vm *v, object *obj, size_t oldsize, size_t newsize) { -#ifdef MORPHO_DEBUG_GCSIZETRACKING - dictionary_insert(&sizecheck, MORPHO_OBJECT(obj), MORPHO_INTEGER(newsize)); -#endif - if (!MORPHO_ISGARBAGECOLLECTED(MORPHO_OBJECT(obj))) return; - v->bound-=oldsize; - v->bound+=newsize; -} - - -/** @brief Checks if an object is managed by the garbage collector - * @param obj the object to check - * @returns true if it is managed, false otherwise - */ -bool morpho_ismanagedobject(object *obj) { - return (obj->status==OBJECT_ISUNMARKED || obj->status==OBJECT_ISMARKED); -} - /** Runs a program * @param[in] v - the virtual machine to use * @param[in] p - program to run @@ -2137,13 +2213,13 @@ void morpho_initialize(void) { compile_initialize(); debugger_initialize(); extensions_initialize(); + help_initialize(); #ifdef MORPHO_DEBUG_GCSIZETRACKING dictionary_init(&sizecheck); #endif morpho_defineerror(ERROR_ALLOCATIONFAILED, ERROR_EXIT, ERROR_ALLOCATIONFAILED_MSG); - morpho_defineerror(ERROR_INTERNALERROR, ERROR_EXIT, ERROR_INTERNALERROR_MSG); morpho_defineerror(ERROR_ERROR, ERROR_HALT, ERROR_ERROR_MSG); morpho_defineerror(VM_STCKOVFLW, ERROR_HALT, VM_STCKOVFLW_MSG); @@ -2165,10 +2241,9 @@ void morpho_initialize(void) { morpho_defineerror(VM_NOTINDEXABLE, ERROR_HALT, VM_NOTINDEXABLE_MSG); morpho_defineerror(VM_OUTOFBOUNDS, ERROR_HALT, VM_OUTOFBOUNDS_MSG); morpho_defineerror(VM_NONNUMINDX, ERROR_HALT, VM_NONNUMINDX_MSG); - morpho_defineerror(VM_ARRAYWRONGDIM, ERROR_HALT, VM_ARRAYWRONGDIM_MSG); morpho_defineerror(VM_DVZR, ERROR_HALT, VM_DVZR_MSG); - morpho_defineerror(VM_GETINDEXARGS, ERROR_HALT, VM_GETINDEXARGS_MSG); morpho_defineerror(VM_MLTPLDSPTCHFLD, ERROR_HALT, VM_MLTPLDSPTCHFLD_MSG); + morpho_defineerror(VM_TYPECHK, ERROR_HALT, VM_TYPECHK_MSG); morpho_defineerror(VM_DBGQUIT, ERROR_HALT, VM_DBGQUIT_MSG); diff --git a/src/datastructures/dictionary.c b/src/datastructures/dictionary.c index 975f83483..fcad4328b 100644 --- a/src/datastructures/dictionary.c +++ b/src/datastructures/dictionary.c @@ -160,7 +160,7 @@ void dictionary_init(dictionary *dict) { /** @brief Clears a dictionary structure, freeing attached memory * @param dict the dictionary to clear - * @warning This doens't free keys or values in the dictionary. */ + * @warning This doesn't free keys or values in the dictionary. */ void dictionary_clear(dictionary *dict) { if (dict->contents) MORPHO_FREE(dict->contents); dictionary_init(dict); @@ -385,6 +385,16 @@ static inline bool _dictionary_get(dictionary *dict, value key, bool intern, val return false; } +/** @brief If a key equal to key is present, returns that stored key and (if val) its value; otherwise returns MORPHO_NIL. */ +value dictionary_getkey(dictionary *dict, value key, value *val) { + dictionaryentry *entry = NULL; + if (dictionary_find(dict, key, false, &entry)) { + if (val) *val = entry->val; + return entry->key; + } + return MORPHO_NIL; +} + /** @brief Retrieves a value from a dictionary given a key * @param[in] dict the dictionary to get * @param[in] key key to locate diff --git a/src/datastructures/dictionary.h b/src/datastructures/dictionary.h index 43b4c3158..efcb6d863 100644 --- a/src/datastructures/dictionary.h +++ b/src/datastructures/dictionary.h @@ -58,6 +58,7 @@ void dictionary_freecontents(dictionary *dict, bool freekeys, bool freevals); bool dictionary_insert(dictionary *dict, value key, value val); bool dictionary_insertintern(dictionary *dict, value key, value val); value dictionary_intern(dictionary *dict, value key); +value dictionary_getkey(dictionary *dict, value key, value *val); bool dictionary_get(dictionary *dict, value key, value *val); bool dictionary_getintern(dictionary *dict, value key, value *val); bool dictionary_remove(dictionary *dict, value key); diff --git a/src/datastructures/error.h b/src/datastructures/error.h index 9f7aad871..536f1cab0 100644 --- a/src/datastructures/error.h +++ b/src/datastructures/error.h @@ -112,9 +112,6 @@ void morpho_unreachable(const char *explanation); #define ERROR_ALLOCATIONFAILED "Alloc" #define ERROR_ALLOCATIONFAILED_MSG "Memory allocation failed." -#define ERROR_INTERNALERROR "Intrnl" -#define ERROR_INTERNALERROR_MSG "Internal error (contact developer)." - #define ERROR_ERROR "Err" #define ERROR_ERROR_MSG "Error." @@ -165,7 +162,7 @@ void morpho_unreachable(const char *explanation); #define VM_INVALIDARGS_MSG "Expected %u arguments but got %u." #define VM_NOOPTARG "NoOptArg" -#define VM_NOOPTARG_MSG "Function doens't expect optional arguments." +#define VM_NOOPTARG_MSG "Function doesn't expect optional arguments." #define VM_UNKNWNOPTARG "UnkwnOptArg" #define VM_UNKNWNOPTARG_MSG "Unknown optional argument '%s'." @@ -182,21 +179,18 @@ void morpho_unreachable(const char *explanation); #define VM_NONNUMINDX "NonNmIndx" #define VM_NONNUMINDX_MSG "Non-numerical array index." -#define VM_ARRAYWRONGDIM "ArrayDim" -#define VM_ARRAYWRONGDIM_MSG "Incorrect number of dimensions for array." - #define VM_DBGQUIT "DbgQuit" #define VM_DBGQUIT_MSG "Program terminated by user in debugger." #define VM_DVZR "DvZr" #define VM_DVZR_MSG "Division by zero." -#define VM_GETINDEXARGS "NonintIndex" -#define VM_GETINDEXARGS_MSG "Noninteger array index." - #define VM_MLTPLDSPTCHFLD "MltplDsptchFld" #define VM_MLTPLDSPTCHFLD_MSG "Multiple dispatch could not find an implementation that matches these arguments." +#define VM_TYPECHK "TypeChk" +#define VM_TYPECHK_MSG "Type violation: Attempted to assign type %s to an %s variable." + /* ------------------------------------------------------- * Error interface * ------------------------------------------------------- */ diff --git a/src/datastructures/object.c b/src/datastructures/object.c index 063655e89..b151a6bc5 100644 --- a/src/datastructures/object.c +++ b/src/datastructures/object.c @@ -58,11 +58,7 @@ void object_init(object *obj, objecttype type) { /** Frees an object */ void object_free(object *obj) { #ifdef MORPHO_DEBUG_LOGGARBAGECOLLECTOR - if (obj) { - fprintf(stderr, "Free object %p of type %d ", (void *) obj, obj->type); - morpho_printvalue(NULL, MORPHO_OBJECT(obj)); - fprintf(stderr, "\n"); - } + if (obj) fprintf(stderr, "Free object %p of type %d.\n", (void *) obj, obj->type); #endif if (object_getdefn(obj)->freefn) object_getdefn(obj)->freefn(obj); MORPHO_FREE(obj); @@ -131,11 +127,11 @@ void morpho_freeobject(value val) { * ********************************************************************** */ /** @brief Sets the veneer class for a particular object type */ -void object_setveneerclass(objecttype type, value class) { +void object_setveneerclass(objecttype type, value klass) { if (_objectdefns[type].veneer!=NULL) { UNREACHABLE("Veneer class redefined.\n"); } - _objectdefns[type].veneer=(object *) MORPHO_GETCLASS(class); + _objectdefns[type].veneer=(object *) MORPHO_GETCLASS(klass); } /** @brief Gets the veneer for a particular object type */ diff --git a/src/datastructures/object.h b/src/datastructures/object.h index 57a87848d..bb102b78c 100644 --- a/src/datastructures/object.h +++ b/src/datastructures/object.h @@ -44,6 +44,9 @@ struct sobject { @warning: Do not use this to compare types, use an appropriate macro like MORPHO_ISXXX */ #define MORPHO_GETOBJECTTYPE(val) (MORPHO_GETOBJECT(val)->type) +/** Gets the type of an object pointer */ +#define OBJECT_GETTYPE(obj) (((object *) (obj))->type) + /** Gets an object's key */ #define MORPHO_GETOBJECTHASH(val) (MORPHO_GETOBJECT(val)->hsh) diff --git a/src/datastructures/program.c b/src/datastructures/program.c index dd13b3ea9..07e1cad2c 100644 --- a/src/datastructures/program.c +++ b/src/datastructures/program.c @@ -80,6 +80,16 @@ instructionindx program_getentry(program *p) { return out; } +/** Retrieves the bytecode associated with the program */ +varray_instruction *program_getbytecode(program *p) { + return &p->code; +} + +/** Retrieves the global function */ +objectfunction *program_getglobalfn(program *p) { + return p->global; +} + /** @brief Binds an object to a program * @details Objects bound to the program are freed with the program; use for static data (e.g. held in constant tables) */ void program_bindobject(program *p, object *obj) { diff --git a/src/datastructures/program.h b/src/datastructures/program.h index 6fc5394d1..0ee32b04d 100644 --- a/src/datastructures/program.h +++ b/src/datastructures/program.h @@ -44,7 +44,7 @@ DECLARE_VARRAY(globalinfo, globalinfo) * ------------------------------------------------------- */ /** @brief Morpho code program and associated data */ -typedef struct { +typedef struct sprogram { varray_instruction code; /** Compiled instructions */ varray_debugannotation annotations; /** Information about how the code connects to the source */ objectfunction *global; /** Pseudofunction containing global data */ @@ -57,7 +57,8 @@ typedef struct { #define MORPHO_PROGRAMSTART 0 void program_setentry(program *p, instructionindx entry); instructionindx program_getentry(program *p); -varray_value *program_getconstanttable(program *p); +varray_instruction *program_getbytecode(program *p); +objectfunction *program_getglobalfn(program *p); void program_bindobject(program *p, object *obj); value program_internsymbol(program *p, value symbol); diff --git a/src/datastructures/signature.c b/src/datastructures/signature.c index 39b5ccbd8..74e35e397 100644 --- a/src/datastructures/signature.c +++ b/src/datastructures/signature.c @@ -69,6 +69,11 @@ bool signature_getparamtype(signature *s, int i, value *type) { return true; } +/** @brief Sets the return type of a function */ +void signature_setreturntype(signature *s, value type) { + s->ret=type; +} + /** @brief Returns the return type from the signature if defined */ value signature_getreturntype(signature *s) { return s->ret; @@ -101,7 +106,7 @@ tokendefn sigtokens[] = { }; /** @brief Initializes a lexer for parsing signatures */ -void signature_initializelexer(lexer *l, char *signature) { +void signature_initializelexer(lexer *l, const char *signature) { lex_init(l, signature, 0); lex_settokendefns(l, sigtokens); lex_seteof(l, SIGNATURE_EOF); @@ -173,7 +178,7 @@ bool signature_parsesignature(parser *p, void *out) { } /** Parses a signature */ -bool signature_parse(char *sig, signature *out) { +bool signature_parse(const char *sig, signature *out) { error err; error_init(&err); @@ -195,6 +200,7 @@ bool signature_parse(char *sig, signature *out) { /** Print a signature for debugging purposes */ void signature_print(signature *s) { + if (MORPHO_ISCLASS(s->ret)) { morpho_printvalue(NULL, MORPHO_GETCLASS(s->ret)->name); printf(" "); } printf("("); for (int i=0; itypes.count; i++) { value type=s->types.data[i]; diff --git a/src/datastructures/signature.h b/src/datastructures/signature.h index d101ae394..18ddc6507 100644 --- a/src/datastructures/signature.h +++ b/src/datastructures/signature.h @@ -26,11 +26,12 @@ bool signature_istyped(signature *s); bool signature_isequal(signature *a, signature *b); bool signature_paramlist(signature *s, int *nparams, value **ptypes); bool signature_getparamtype(signature *s, int i, value *type); +void signature_setreturntype(signature *s, value type); value signature_getreturntype(signature *s); int signature_countparams(signature *s); void signature_set(signature *s, int nparam, value *types); -bool signature_parse(char *sig, signature *out); +bool signature_parse(const char *sig, signature *out); void signature_print(signature *s); diff --git a/src/datastructures/value.c b/src/datastructures/value.c index 9a68336f6..927182120 100644 --- a/src/datastructures/value.c +++ b/src/datastructures/value.c @@ -196,6 +196,47 @@ bool value_minmax(unsigned int nval, value *list, value *min, value *max) { return true; } +/** Extracts a type from a value */ +bool value_type(value v, value *type) { + objectclass *clss = NULL; + + if (MORPHO_ISINSTANCE(v)) { + clss=MORPHO_GETINSTANCE(v)->klass; + } else if (MORPHO_ISOBJECT(v)) { + clss = object_getveneerclass(MORPHO_GETOBJECT(v)->type); + } else clss = value_getveneerclass(v); + + if (clss) *type = MORPHO_OBJECT(clss); + return clss; +} + +/** Recursively searches the parents list of classes to see if the required type is present */ +static bool value_findtypeinparent(objectclass *type, value match) { + for (int i=0; iparents.count; i++) { + if (MORPHO_ISEQUAL(type->parents.data[i], match) || + value_findtypeinparent(MORPHO_GETCLASS(type->parents.data[i]), match)) return true; + } + return false; +} + +/** Checks if an actual type matches a required type */ +bool value_typematch(value type, value match) { + if (MORPHO_ISNIL(type) || // If type is unset, we always match + MORPHO_ISEQUAL(type, match)) return true; // Or if the types are the same + + // Also match if 'match' inherits from 'type' + if (MORPHO_ISCLASS(match)) return value_findtypeinparent(MORPHO_GETCLASS(match), type); + + return false; +} + +/** Checks if a value matches a required type */ +bool value_istype(value v, value type) { + value match; + if (!value_type(v, &match)) return false; + return value_typematch(type, match); +} + /* ********************************************************************** * Varray_values and utility functions * ********************************************************************** */ diff --git a/src/datastructures/value.h b/src/datastructures/value.h index 0d90c7cdb..91f4e2301 100644 --- a/src/datastructures/value.h +++ b/src/datastructures/value.h @@ -9,6 +9,7 @@ #include #include +#include #include #include "build.h" @@ -23,10 +24,10 @@ typedef struct sobject object; /** Values are the basic data type in morpho: each variable declared with 'var' corresponds to one value. Values can contain the following types: - VALUE_NIL - nil - VALUE_INTEGER - 32 bit integer - VALUE_DOUBLE - - VALUE_BOOL - boolean type + VALUE_NIL - nil + VALUE_INTEGER - 32 bit integer + VALUE_DOUBLE - + VALUE_BOOL - boolean type VALUE_OBJECT - pointer to an object The implementation of a value is intentionally opaque and can be NAN boxed into a 64-bit double or left as a struct. This file therefore defines several kinds of macro to: @@ -41,92 +42,94 @@ typedef struct sobject object; typedef uint64_t value; /** Define macros that enable us to refer to various bits */ -#define SIGN_BIT ((uint64_t) 0x8000000000000000) -#define QNAN ((uint64_t) 0x7ffc000000000000) -#define LOWER_WORD ((uint64_t) 0x00000000ffffffff) +#define QNAN ((uint64_t) 0x7ff8000000000000ull) +#define LOWER_WORD ((uint64_t) 0x00000000ffffffffull) -/** Store the type in bits 47-49 */ -#define TAG_NIL (1ull<<47) // 001 -#define TAG_BOOL (2ull<<47) // 010 -#define TAG_INT (3ull<<47) // 011 -#define TAG_OBJ SIGN_BIT +/** Store the type in bits 48-50 */ +#define TAG_SHIFT 48 +#define TAG_MASK ((uint64_t) (0x7ull << TAG_SHIFT)) // bits 48..50 +#define PAYLOAD_MASK ((uint64_t) 0x0000ffffffffffffull) // bits 0..47 +#define EXP_MASK ((uint64_t) 0x7ff0000000000000ull) // Exponent bits + +#define TAG_NIL ((uint64_t) 1ull << TAG_SHIFT) +#define TAG_BOOL ((uint64_t) 2ull << TAG_SHIFT) +#define TAG_INT ((uint64_t) 3ull << TAG_SHIFT) +#define TAG_OBJ ((uint64_t) 4ull << TAG_SHIFT) + +/** Manipulations */ +#define MORPHO_EXPALLONES(v) ((((uint64_t)(v)) & EXP_MASK) == EXP_MASK) +#define MORPHO_TAGBITS(v) (((uint64_t)(v)) & TAG_MASK) /** Bool values are stored in the lowest bit */ #define TAG_TRUE 1 #define TAG_FALSE 0 -/** Bit mask used to select type bits */ -#define TYPE_BITS (TAG_OBJ | TAG_NIL | TAG_BOOL | TAG_INT) - /** Map VALUE_XXX macros to type bits */ #define VALUE_NIL (TAG_NIL) #define VALUE_INTEGER (TAG_INT) -#define VALUE_DOUBLE () +#define VALUE_DOUBLE ((uint64_t) 0ull) #define VALUE_BOOL (TAG_BOOL) #define VALUE_OBJECT (TAG_OBJ) /** Get the type from a value */ -#define MORPHO_GETTYPE(x) ((x) & TYPE_BITS) - -/** Union to enable conversion of a double to a 64 bit integer */ -typedef union { - uint64_t bits; - double num; -} doubleunion; +#define MORPHO_GETTYPE(x) (MORPHO_ISBOXED(x) ? MORPHO_TAGBITS(x) : VALUE_DOUBLE) -/** Converts a double to a value by type punning */ +/** Converts a double to a value */ static inline value doubletovalue(double num) { - doubleunion data; - data.num = num; - return data.bits; + value bits; + memcpy(&bits, &num, sizeof(bits)); + // If this is NaN or Inf (exp all ones), force tag bits to 0 so it is a genuine float NaN/Inf + if ((bits & EXP_MASK) == EXP_MASK) { + bits &= ~TAG_MASK; + } + return bits; } -/** Converts a value to a double by type punning */ +/** Converts a value to a double */ static inline double valuetodouble(value v) { - doubleunion data; - data.bits = v; - return data.num; + double num; + memcpy(&num, &v, sizeof(num)); + return num; } /** Create a literal */ -#define MORPHO_NIL ((value) (uint64_t) (QNAN | TAG_NIL)) -#define MORPHO_TRUE ((value) (uint64_t) (QNAN | TAG_BOOL | TAG_TRUE)) -#define MORPHO_FALSE ((value) (uint64_t) (QNAN | TAG_BOOL | TAG_FALSE)) +#define MORPHO_NIL ((value) (QNAN | TAG_NIL)) +#define MORPHO_TRUE ((value) (QNAN | TAG_BOOL | TAG_TRUE)) +#define MORPHO_FALSE ((value) (QNAN | TAG_BOOL | TAG_FALSE)) -#define MORPHO_INTEGER(x) ((((uint64_t) (x)) & LOWER_WORD) | QNAN | TAG_INT) +#define MORPHO_BOOL(x) ((x) ? MORPHO_TRUE : MORPHO_FALSE) +#define MORPHO_INTEGER(x) ((value) (QNAN | TAG_INT | (((uint64_t)(x)) & LOWER_WORD))) #define MORPHO_FLOAT(x) doubletovalue(x) -#define MORPHO_BOOL(x) ((x) ? MORPHO_TRUE : MORPHO_FALSE) -#define MORPHO_OBJECT(x) ((value) (TAG_OBJ | QNAN | (uint64_t)(uintptr_t)(x))) +#define MORPHO_OBJECT(x) ((value) (QNAN | TAG_OBJ | (((uint64_t)(uintptr_t)(x)) & PAYLOAD_MASK))) /** Test for the type of a value */ -#define MORPHO_ISNIL(v) ((v) == MORPHO_NIL) -#define MORPHO_ISINTEGER(v) (((v) & (QNAN | TYPE_BITS)) == (QNAN | TAG_INT)) -#define MORPHO_ISFLOAT(v) (((v) & QNAN) != QNAN) -#define MORPHO_ISBOOL(v) (((v) & (QNAN | TYPE_BITS)) == (QNAN | TAG_BOOL)) -#define MORPHO_ISOBJECT(v) \ - (((v) & (QNAN | TYPE_BITS))== (QNAN | TAG_OBJ)) +#define MORPHO_ISNIL(v) ((v) == MORPHO_NIL) +#define MORPHO_ISBOXED(v) (MORPHO_EXPALLONES(v) && (MORPHO_TAGBITS(v) != 0)) +#define MORPHO_ISINTEGER(v) (MORPHO_ISBOXED(v) && (MORPHO_TAGBITS(v) == TAG_INT)) +#define MORPHO_ISBOOL(v) (MORPHO_ISBOXED(v) && (MORPHO_TAGBITS(v) == TAG_BOOL)) +#define MORPHO_ISOBJECT(v) (MORPHO_ISBOXED(v) && (MORPHO_TAGBITS(v) == TAG_OBJ)) +#define MORPHO_ISFLOAT(v) (!MORPHO_ISBOXED(v)) /** Get a value */ -#define MORPHO_GETINTEGERVALUE(v) ((int) ((uint32_t) (v & LOWER_WORD))) +#define MORPHO_GETPAYLOAD(v) (((uint64_t)(v)) & PAYLOAD_MASK) +#define MORPHO_GETINTEGERVALUE(v) ((int32_t) ((uint32_t)((uint64_t)(v) & LOWER_WORD))) #define MORPHO_GETFLOATVALUE(v) valuetodouble(v) #define MORPHO_GETBOOLVALUE(v) ((v) == MORPHO_TRUE) -#define MORPHO_GETOBJECT(v) ((object *) (uintptr_t) ((v) & ~(TAG_OBJ | QNAN))) +#define MORPHO_GETOBJECT(v) ((object *)(uintptr_t)(((uint64_t)(v)) & PAYLOAD_MASK)) static inline bool morpho_ofsametype(value a, value b) { - if (MORPHO_ISFLOAT(a) || MORPHO_ISFLOAT(b)) { - return MORPHO_ISFLOAT(a) && MORPHO_ISFLOAT(b); - } else { - if ((a & TYPE_BITS)==(b & TYPE_BITS)) { - return true; - } - } + bool af = MORPHO_ISFLOAT(a); + bool bf = MORPHO_ISFLOAT(b); - return false; + if (af || bf) return (af && bf); + + /* both are boxed: compare tag field only */ + return ((a & TAG_MASK) == (b & TAG_MASK)); } /** Get a non-object's type field as an integer */ static inline int _getorderedtype(value x) { - return (MORPHO_ISFLOAT(x) ? 0 : (((x) & TYPE_BITS)>>47) & 0x7); + return MORPHO_ISFLOAT(x) ? 0 : (int)(((uint64_t)x & TAG_MASK) >> TAG_SHIFT); } #define MORPHO_GETORDEREDTYPE(x) _getorderedtype(x) @@ -240,6 +243,19 @@ bool morpho_valuetofloat(value v, double *out); #define MORPHO_ISFALSE(x) (morpho_isfalse(x)) #define MORPHO_ISTRUE(x) (!morpho_isfalse(x)) +/* ------------------------------------------------------- + * Type checking + * ------------------------------------------------------- */ + +/** Get the type associated with a value */ +bool value_type(value v, value *type); + +/** Check whether an actual type matches a required type */ +bool value_typematch(value type, value match); + +/** Check whether a value matches a required type */ +bool value_istype(value v, value type); + /* ------------------------------------------------------- * Varrays of values * ------------------------------------------------------- */ diff --git a/src/datastructures/varray.h b/src/datastructures/varray.h index dbf836db6..d983b1263 100644 --- a/src/datastructures/varray.h +++ b/src/datastructures/varray.h @@ -44,7 +44,8 @@ bool varray_##name##add(varray_##name *v, type *data, int count); \ bool varray_##name##resize(varray_##name *v, int count); \ int varray_##name##write(varray_##name *v, type data); \ - void varray_##name##clear(varray_##name *v); + void varray_##name##clear(varray_##name *v); \ + bool varray_##name##pop(varray_##name *v, type *dest); #define DEFINE_VARRAY(name, type) \ void varray_##name##init(varray_##name *v) { \ diff --git a/src/datastructures/version.c b/src/datastructures/version.c index 32924c839..ac87977bd 100644 --- a/src/datastructures/version.c +++ b/src/datastructures/version.c @@ -34,7 +34,7 @@ int version_cmp(version *a, version *b) { * @param[in] max - (optional) maximum version number * @returns true if min <= v <= max */ bool version_check(version *v, version *min, version *max) { - int l = (min ? version_cmp(min, v) : 0); + int l = (min ? version_cmp(v, min) : 0); int r = (max ? version_cmp(v, max) : 0); return (l>=0 && r<=0); diff --git a/src/debug/debug.c b/src/debug/debug.c index 712ef0653..ffec99cd5 100644 --- a/src/debug/debug.c +++ b/src/debug/debug.c @@ -345,6 +345,7 @@ assemblyrule assemblyrules[] ={ { OP_LE, "le ", "rA, rB, rC" }, { OP_PRINT, "print", "rA" }, + { OP_TYPECHECK, "typecheck", "rA, cX" }, { OP_B, "b", "+" }, { OP_BIF, "bif", "rA +" }, diff --git a/src/debug/profile.c b/src/debug/profile.c index 6a677d3ea..2488157fe 100644 --- a/src/debug/profile.c +++ b/src/debug/profile.c @@ -205,7 +205,7 @@ bool morpho_profile(vm *v, program *p) { profiler_init(&profile, p); - if (MorphoThread_create(&profile.profiler, profiler_thread, v)) { + if (!MorphoThread_create(&profile.profiler, profiler_thread, v)) { UNREACHABLE("Unable to run profiler."); } diff --git a/src/geometry/fespace.c b/src/geometry/fespace.c index 17b3603ab..b47c79a8c 100644 --- a/src/geometry/fespace.c +++ b/src/geometry/fespace.c @@ -155,13 +155,37 @@ fespace cg2_1d = { */ void cg3_1dinterpolate(double *lambda, double *wts) { - double a = (9.0/2.0)*lambda[0]*lambda[1]; + double a = 4.5*lambda[0]*lambda[1]; wts[0]=lambda[0]*(1-a); wts[1]=lambda[1]*(1-a); wts[2]=a*(2*lambda[0]-lambda[1]); wts[3]=a*(2*lambda[1]-lambda[0]); } +void cg3_1dgrad(double *lambda, double *grad) { + // Gij = d Xi[i] / d lambda[j] + // Note this is in column-major order! + double g[] = + { 1-9*lambda[0]*lambda[1], -4.5*lambda[1]*lambda[1], + 4.5*(4*lambda[0]-lambda[1])*lambda[1], 9*lambda[1]*(lambda[1]-lambda[0]), + + -4.5*lambda[0]*lambda[0], 1-9*lambda[0]*lambda[1], + 9*lambda[0]*(lambda[0]-lambda[1]), 4.5*(4*lambda[1]-lambda[0])*lambda[0] + }; + memcpy(grad, g, sizeof(g)); +} + +void cg3_1dhess(double *lambda, double *hess) { + double x = lambda[1]; + + #define H(node) hess[FESPACE_HESS_INDEX(4, 1, 0, 0, node)] + H(0) = 18 - 27*x; + H(1) = 27*x - 9; + H(2) = -45 + 81*x; + H(3) = 36 - 81*x; + #undef H +} + unsigned int cg3_1dshape[] = { 1, 2 }; double cg3_1dnodes[] = { 0.0, 1.0, 1.0/3.0, 2.0/3.0 }; @@ -184,6 +208,8 @@ fespace cg3_1d = { .nsubel = 1, .nodes = cg3_1dnodes, .ifn = cg3_1dinterpolate, + .gfn = cg3_1dgrad, + .hfn = cg3_1dhess, .eldefn = cg3_1ddefn, .lower = NULL }; @@ -273,6 +299,16 @@ void cg2_2dgrad(double *lambda, double *grad) { memcpy(grad, g, sizeof(g)); } +void cg2_2dhess(double *lambda, double *hess) { + // Hijq = d^2 Xi[i] / d x[j] d x[q] in column-major order + #define H(row,col,node) hess[FESPACE_HESS_INDEX(6, 2, row, col, node)] + H(0,0,0)=4; H(0,0,1)=4; H(0,0,2)=0; H(0,0,3)=-8; H(0,0,4)=0; H(0,0,5)=0; + H(1,0,0)=4; H(1,0,1)=0; H(1,0,2)=0; H(1,0,3)=-4; H(1,0,4)=4; H(1,0,5)=-4; + H(0,1,0)=4; H(0,1,1)=0; H(0,1,2)=0; H(0,1,3)=-4; H(0,1,4)=4; H(0,1,5)=-4; + H(1,1,0)=4; H(1,1,1)=0; H(1,1,2)=4; H(1,1,3)=0; H(1,1,4)=0; H(1,1,5)=-8; + #undef H +} + unsigned int cg2_2dshape[] = { 1, 1, 0 }; double cg2_2dnodes[] = { 0.0, 0.0, @@ -310,10 +346,164 @@ fespace cg2_2d = { .nodes = cg2_2dnodes, .ifn = cg2_2dinterpolate, .gfn = cg2_2dgrad, + .hfn = cg2_2dhess, .eldefn = cg2_2deldefn, .lower = cg2_2d_lower }; +/* ------------------------------------------------------- + * CG3 element in 2D + * ------------------------------------------------------- */ + +/* 2 + * | \ + * 7 6 + * | \ + * 8 10 5 + * | \ + * 0-3--4-1 + */ + +void cg3_2dinterpolate(double *lambda, double *wts) { + wts[0]=lambda[0]*(1.0 + 4.5*(lambda[0]-1)*lambda[0]); + wts[1]=lambda[1]*(1.0 + 4.5*(lambda[1]-1)*lambda[1]); + wts[2]=lambda[2]*(1.0 + 4.5*(lambda[2]-1)*lambda[2]); + wts[3]=4.5*lambda[0]*lambda[1]*(3*lambda[0]-1.0); + wts[4]=4.5*lambda[0]*lambda[1]*(3*lambda[1]-1.0); + wts[5]=4.5*lambda[1]*lambda[2]*(3*lambda[1]-1.0); + wts[6]=4.5*lambda[1]*lambda[2]*(3*lambda[2]-1.0); + wts[7]=4.5*lambda[0]*lambda[2]*(3*lambda[2]-1.0); + wts[8]=4.5*lambda[0]*lambda[2]*(3*lambda[0]-1.0); + wts[9]=27.0*lambda[0]*lambda[1]*lambda[2]; +} + +void cg3_2dgrad(double *lambda, double *grad) { + // Gij = d Xi[i] / d lambda[j] in col. major order + double g[] = + { 1.0 + 4.5*lambda[0]*(3*lambda[0]-2), 0, 0, + 4.5*lambda[1]*(6*lambda[0]-1), 4.5*lambda[1]*(3*lambda[1]-1), + 0, 0, + 4.5*lambda[2]*(3*lambda[2]-1), 4.5*lambda[2]*(6*lambda[0]-1), + 27*lambda[1]*lambda[2], + + 0, 1.0 + 4.5*lambda[1]*(3*lambda[1]-2), 0, + 4.5*lambda[0]*(3*lambda[0]-1), 4.5*lambda[0]*(6*lambda[1]-1), + 4.5*lambda[2]*(6*lambda[1]-1), 4.5*lambda[2]*(3*lambda[2]-1), + 0, 0, + 27*lambda[0]*lambda[2], + + 0, 0, 1.0 + 4.5*lambda[2]*(3*lambda[2]-2), + 0, 0, + 4.5*lambda[1]*(3*lambda[1]-1), 4.5*lambda[1]*(6*lambda[2]-1), + 4.5*lambda[0]*(6*lambda[2]-1), 4.5*lambda[0]*(3*lambda[0]-1), + 27*lambda[0]*lambda[1], + }; + memcpy(grad, g, sizeof(g)); +} + +void cg3_2dhess(double *lambda, double *hess) { + double x = lambda[1]; + double y = lambda[2]; + + // Hijq = d^2 Xi[i] / d x[j] d x[q] in column-major order + #define H(row,col,node) hess[FESPACE_HESS_INDEX(10, 2, row, col, node)] + H(0,0,0) = 18 - 27*x - 27*y; + H(0,0,1) = 27*x - 9; + H(0,0,2) = 0; + H(0,0,3) = -45 + 81*x + 54*y; + H(0,0,4) = 36 - 81*x - 27*y; + H(0,0,5) = 27*y; + H(0,0,6) = 0; + H(0,0,7) = 0; + H(0,0,8) = 27*y; + H(0,0,9) = -54*y; + + H(1,0,0) = 18 - 27*x - 27*y; + H(1,0,1) = 0; + H(1,0,2) = 0; + H(1,0,3) = -45.0/2 + 54*x + 27*y; + H(1,0,4) = 9.0/2 - 27*x; + H(1,0,5) = -9.0/2 + 27*x; + H(1,0,6) = -9.0/2 + 27*y; + H(1,0,7) = 9.0/2 - 27*y; + H(1,0,8) = -45.0/2 + 27*x + 54*y; + H(1,0,9) = 27 - 54*x - 54*y; + + H(0,1,0) = 18 - 27*x - 27*y; + H(0,1,1) = 0; + H(0,1,2) = 0; + H(0,1,3) = -45.0/2 + 54*x + 27*y; + H(0,1,4) = 9.0/2 - 27*x; + H(0,1,5) = -9.0/2 + 27*x; + H(0,1,6) = -9.0/2 + 27*y; + H(0,1,7) = 9.0/2 - 27*y; + H(0,1,8) = -45.0/2 + 27*x + 54*y; + H(0,1,9) = 27 - 54*x - 54*y; + + H(1,1,0) = 18 - 27*x - 27*y; + H(1,1,1) = 0; + H(1,1,2) = 27*y - 9; + H(1,1,3) = 27*x; + H(1,1,4) = 0; + H(1,1,5) = 0; + H(1,1,6) = 27*x; + H(1,1,7) = 36 - 27*x - 81*y; + H(1,1,8) = -45 + 54*x + 81*y; + H(1,1,9) = -54*x; + #undef H +} + +unsigned int cg3_2dshape[] = { 1, 2, 1 }; + +double cg3_2dnodes[] = { 0.0, 0.0, + 1.0, 0.0, + 0.0, 1.0, + 0.3333333333333333,0.0, + 0.6666666666666666,0.0, + 0.6666666666666666,0.3333333333333333, + 0.3333333333333333,0.6666666666666666, + 0,0.6666666666666666, + 0,0.3333333333333333, + 0.3333333333333333,0.3333333333333333 }; + +eldefninstruction cg3_2deldefn[] = { + LINE(0,0,1), // Identify line subelement with vertex indices (0,1) + LINE(1,1,2), // Identify line subelement with vertex indices (1,2) + LINE(2,2,0), // Identify line subelement with vertex indices (2,0) + AREA(3,0,1,2), // Identify area subelement with vertex indices (0,1,2) + QUANTITY(0,0,0), // Fetch quantity on vertex 0 + QUANTITY(0,1,0), // Fetch quantity on vertex 1 + QUANTITY(0,2,0), // Fetch quantity on vertex 2 + QUANTITY(1,0,0), // Fetch quantity 0 from line 0 + QUANTITY(1,0,1), // Fetch quantity 1 from line 0 + QUANTITY(1,1,0), // Fetch quantity 0 from line 1 + QUANTITY(1,1,1), // Fetch quantity 1 from line 1 + QUANTITY(1,2,0), // Fetch quantity 0 from line 2 + QUANTITY(1,2,1), // Fetch quantity 1 from line 2 + QUANTITY(2,3,0), // Fetch quantity 0 from area 0 + ENDDEFN +}; + +fespace *cg3_2d_lower[] = { + &cg3_1d, + NULL +}; + +fespace cg3_2d = { + .name = "CG3", + .grade = 2, + .shape = cg3_2dshape, + .degree = 3, + .nnodes = 10, + .nsubel = 4, + .nodes = cg3_2dnodes, + .ifn = cg3_2dinterpolate, + .gfn = cg3_2dgrad, + .hfn = cg3_2dhess, + .eldefn = cg3_2deldefn, + .lower = cg3_2d_lower +}; + /* ------------------------------------------------------- * CG1 element in 3D * ------------------------------------------------------- */ @@ -420,6 +610,23 @@ void cg2_3dgrad(double *lambda, double *grad) { // TODO: FIX memcpy(grad, g, sizeof(g)); } +void cg2_3dhess(double *lambda, double *hess) { + // Hijq = d^2 Xi[i] / d x[j] d x[q] in column-major tensor order + #define H(row,col,node) hess[FESPACE_HESS_INDEX(10, 3, row, col, node)] + H(0,0,0)=4; H(0,0,1)=4; H(0,0,2)=0; H(0,0,3)=0; H(0,0,4)=-8; H(0,0,5)=0; H(0,0,6)=0; H(0,0,7)=0; H(0,0,8)=0; H(0,0,9)=0; + H(1,0,0)=4; H(1,0,1)=0; H(1,0,2)=0; H(1,0,3)=0; H(1,0,4)=-4; H(1,0,5)=4; H(1,0,6)=-4; H(1,0,7)=0; H(1,0,8)=0; H(1,0,9)=0; + H(2,0,0)=4; H(2,0,1)=0; H(2,0,2)=0; H(2,0,3)=0; H(2,0,4)=-4; H(2,0,5)=0; H(2,0,6)=0; H(2,0,7)=-4; H(2,0,8)=4; H(2,0,9)=0; + + H(0,1,0)=4; H(0,1,1)=0; H(0,1,2)=0; H(0,1,3)=0; H(0,1,4)=-4; H(0,1,5)=4; H(0,1,6)=-4; H(0,1,7)=0; H(0,1,8)=0; H(0,1,9)=0; + H(1,1,0)=4; H(1,1,1)=0; H(1,1,2)=4; H(1,1,3)=0; H(1,1,4)=0; H(1,1,5)=0; H(1,1,6)=-8; H(1,1,7)=0; H(1,1,8)=0; H(1,1,9)=0; + H(2,1,0)=4; H(2,1,1)=0; H(2,1,2)=0; H(2,1,3)=0; H(2,1,4)=0; H(2,1,5)=0; H(2,1,6)=-4; H(2,1,7)=-4; H(2,1,8)=0; H(2,1,9)=4; + + H(0,2,0)=4; H(0,2,1)=0; H(0,2,2)=0; H(0,2,3)=0; H(0,2,4)=-4; H(0,2,5)=0; H(0,2,6)=0; H(0,2,7)=-4; H(0,2,8)=4; H(0,2,9)=0; + H(1,2,0)=4; H(1,2,1)=0; H(1,2,2)=0; H(1,2,3)=0; H(1,2,4)=0; H(1,2,5)=0; H(1,2,6)=-4; H(1,2,7)=-4; H(1,2,8)=0; H(1,2,9)=4; + H(2,2,0)=4; H(2,2,1)=0; H(2,2,2)=0; H(2,2,3)=4; H(2,2,4)=0; H(2,2,5)=0; H(2,2,6)=0; H(2,2,7)=-8; H(2,2,8)=0; H(2,2,9)=0; + #undef H +} + unsigned int cg2_3dshape[] = { 1, 1, 0, 0 }; double cg2_3dnodes[] = { 0, 0, 0, @@ -469,10 +676,177 @@ fespace cg2_3d = { .nodes = cg2_3dnodes, .ifn = cg2_3dinterpolate, .gfn = cg2_3dgrad, + .hfn = cg2_3dhess, .eldefn = cg2_3deldefn, .lower = cg2_3d_lower }; +/* ------------------------------------------------------- + * CG3 element in 3D + * ------------------------------------------------------- */ + +/* z = 0 layer: z = 1/3 layer: z = 2/3 layer: z = 1 layer: + * + * 2 14 + * | \ . . + * 9 7 . . 15 + * | \ 19 18 . . + * 8 16 6 . . . . + * | \ . . . . + * 0--4--5--1 10..17..12 11...13 3 + */ + +void cg3_3dinterpolate(double *lambda, double *wts) { + int k=0; + int edges[6][2] = { {0,1}, {1,2}, {2,0}, {0,3}, {1,3}, {2,3} }; + int faces[4][3] = { {0,1,2}, {0,3,1}, {1,3,2}, {2,3,0} }; + + for (int i=0; i<4; i++) { + wts[k++]=0.5*lambda[i]*(3*lambda[i]-1)*(3*lambda[i]-2); + } + + for (int i=0; i<6; i++) { + int a=edges[i][0], b=edges[i][1]; + wts[k++]=4.5*lambda[a]*lambda[b]*(3*lambda[a]-1); + wts[k++]=4.5*lambda[a]*lambda[b]*(3*lambda[b]-1); + } + + for (int i=0; i<4; i++) { + int a=faces[i][0], b=faces[i][1], c=faces[i][2]; + wts[k++]=27.0*lambda[a]*lambda[b]*lambda[c]; + } +} + +void cg3_3dgrad(double *lambda, double *grad) { + int edges[6][2] = { {0,1}, {1,2}, {2,0}, {0,3}, {1,3}, {2,3} }; + int faces[4][3] = { {0,1,2}, {0,3,1}, {1,3,2}, {2,3,0} }; + + memset(grad, 0, sizeof(double)*20*4); + + for (int j=0; j<4; j++) { + grad[j*20+j]=13.5*lambda[j]*lambda[j]-9.0*lambda[j]+1.0; + } + + int k=4; + for (int i=0; i<6; i++) { + int a=edges[i][0], b=edges[i][1]; + + grad[a*20+k]=4.5*lambda[b]*(6*lambda[a]-1); + grad[b*20+k]=4.5*lambda[a]*(3*lambda[a]-1); + k++; + + grad[a*20+k]=4.5*lambda[b]*(3*lambda[b]-1); + grad[b*20+k]=4.5*lambda[a]*(6*lambda[b]-1); + k++; + } + + for (int i=0; i<4; i++) { + int a=faces[i][0], b=faces[i][1], c=faces[i][2]; + grad[a*20+k]=27.0*lambda[b]*lambda[c]; + grad[b*20+k]=27.0*lambda[a]*lambda[c]; + grad[c*20+k]=27.0*lambda[a]*lambda[b]; + k++; + } +} + +void cg3_3dhess(double *lambda, double *hess) { + double x=lambda[1], y=lambda[2], z=lambda[3]; + + #define H(row,col,node) hess[FESPACE_HESS_INDEX(20, 3, row, col, node)] + H(0,0,0)=18-27*x-27*y-27*z; H(0,0,1)=27*x-9; H(0,0,2)=0; H(0,0,3)=0; H(0,0,4)=81*x+54*y+54*z-45; H(0,0,5)=-81*x-27*y-27*z+36; H(0,0,6)=27*y; H(0,0,7)=0; H(0,0,8)=0; H(0,0,9)=27*y; H(0,0,10)=27*z; H(0,0,11)=0; H(0,0,12)=27*z; H(0,0,13)=0; H(0,0,14)=0; H(0,0,15)=0; H(0,0,16)=-54*y; H(0,0,17)=-54*z; H(0,0,18)=0; H(0,0,19)=0; + H(1,0,0)=18-27*x-27*y-27*z; H(1,0,1)=0; H(1,0,2)=0; H(1,0,3)=0; H(1,0,4)=54*x+27*y+27*z-22.5; H(1,0,5)=-27*x+4.5; H(1,0,6)=27*x-4.5; H(1,0,7)=27*y-4.5; H(1,0,8)=-27*y+4.5; H(1,0,9)=27*x+54*y+27*z-22.5; H(1,0,10)=27*z; H(1,0,11)=0; H(1,0,12)=0; H(1,0,13)=0; H(1,0,14)=0; H(1,0,15)=0; H(1,0,16)=-54*x-54*y-27*z+27; H(1,0,17)=-27*z; H(1,0,18)=27*z; H(1,0,19)=-27*z; + H(2,0,0)=18-27*x-27*y-27*z; H(2,0,1)=0; H(2,0,2)=0; H(2,0,3)=0; H(2,0,4)=54*x+27*y+27*z-22.5; H(2,0,5)=-27*x+4.5; H(2,0,6)=0; H(2,0,7)=0; H(2,0,8)=0; H(2,0,9)=27*y; H(2,0,10)=27*x+27*y+54*z-22.5; H(2,0,11)=-27*z+4.5; H(2,0,12)=27*x-4.5; H(2,0,13)=27*z-4.5; H(2,0,14)=0; H(2,0,15)=0; H(2,0,16)=-27*y; H(2,0,17)=-54*x-27*y-54*z+27; H(2,0,18)=27*y; H(2,0,19)=-27*y; + + H(0,1,0)=18-27*x-27*y-27*z; H(0,1,1)=0; H(0,1,2)=0; H(0,1,3)=0; H(0,1,4)=54*x+27*y+27*z-22.5; H(0,1,5)=-27*x+4.5; H(0,1,6)=27*x-4.5; H(0,1,7)=27*y-4.5; H(0,1,8)=-27*y+4.5; H(0,1,9)=27*x+54*y+27*z-22.5; H(0,1,10)=27*z; H(0,1,11)=0; H(0,1,12)=0; H(0,1,13)=0; H(0,1,14)=0; H(0,1,15)=0; H(0,1,16)=-54*x-54*y-27*z+27; H(0,1,17)=-27*z; H(0,1,18)=27*z; H(0,1,19)=-27*z; + H(1,1,0)=18-27*x-27*y-27*z; H(1,1,1)=0; H(1,1,2)=27*y-9; H(1,1,3)=0; H(1,1,4)=27*x; H(1,1,5)=0; H(1,1,6)=0; H(1,1,7)=27*x; H(1,1,8)=-27*x-81*y-27*z+36; H(1,1,9)=54*x+81*y+54*z-45; H(1,1,10)=27*z; H(1,1,11)=0; H(1,1,12)=0; H(1,1,13)=0; H(1,1,14)=27*z; H(1,1,15)=0; H(1,1,16)=-54*x; H(1,1,17)=0; H(1,1,18)=0; H(1,1,19)=-54*z; + H(2,1,0)=18-27*x-27*y-27*z; H(2,1,1)=0; H(2,1,2)=0; H(2,1,3)=0; H(2,1,4)=27*x; H(2,1,5)=0; H(2,1,6)=0; H(2,1,7)=0; H(2,1,8)=-27*y+4.5; H(2,1,9)=27*x+54*y+27*z-22.5; H(2,1,10)=27*x+27*y+54*z-22.5; H(2,1,11)=-27*z+4.5; H(2,1,12)=0; H(2,1,13)=0; H(2,1,14)=27*y-4.5; H(2,1,15)=27*z-4.5; H(2,1,16)=-27*x; H(2,1,17)=-27*x; H(2,1,18)=27*x; H(2,1,19)=-27*x-54*y-54*z+27; + + H(0,2,0)=18-27*x-27*y-27*z; H(0,2,1)=0; H(0,2,2)=0; H(0,2,3)=0; H(0,2,4)=54*x+27*y+27*z-22.5; H(0,2,5)=-27*x+4.5; H(0,2,6)=0; H(0,2,7)=0; H(0,2,8)=0; H(0,2,9)=27*y; H(0,2,10)=27*x+27*y+54*z-22.5; H(0,2,11)=-27*z+4.5; H(0,2,12)=27*x-4.5; H(0,2,13)=27*z-4.5; H(0,2,14)=0; H(0,2,15)=0; H(0,2,16)=-27*y; H(0,2,17)=-54*x-27*y-54*z+27; H(0,2,18)=27*y; H(0,2,19)=-27*y; + H(1,2,0)=18-27*x-27*y-27*z; H(1,2,1)=0; H(1,2,2)=0; H(1,2,3)=0; H(1,2,4)=27*x; H(1,2,5)=0; H(1,2,6)=0; H(1,2,7)=0; H(1,2,8)=-27*y+4.5; H(1,2,9)=27*x+54*y+27*z-22.5; H(1,2,10)=27*x+27*y+54*z-22.5; H(1,2,11)=-27*z+4.5; H(1,2,12)=0; H(1,2,13)=0; H(1,2,14)=27*y-4.5; H(1,2,15)=27*z-4.5; H(1,2,16)=-27*x; H(1,2,17)=-27*x; H(1,2,18)=27*x; H(1,2,19)=-27*x-54*y-54*z+27; + H(2,2,0)=18-27*x-27*y-27*z; H(2,2,1)=0; H(2,2,2)=0; H(2,2,3)=27*z-9; H(2,2,4)=27*x; H(2,2,5)=0; H(2,2,6)=0; H(2,2,7)=0; H(2,2,8)=0; H(2,2,9)=27*y; H(2,2,10)=54*x+54*y+81*z-45; H(2,2,11)=-27*x-27*y-81*z+36; H(2,2,12)=0; H(2,2,13)=27*x; H(2,2,14)=0; H(2,2,15)=27*y; H(2,2,16)=0; H(2,2,17)=-54*x; H(2,2,18)=0; H(2,2,19)=-54*y; + #undef H +} + +unsigned int cg3_3dshape[] = { 1, 2, 1, 0 }; + +double cg3_3dnodes[] = { + 0.0, 0.0, 0.0, + 1.0, 0.0, 0.0, + 0.0, 1.0, 0.0, + 0.0, 0.0, 1.0, + 1.0/3.0, 0.0, 0.0, + 2.0/3.0, 0.0, 0.0, + 2.0/3.0, 1.0/3.0, 0.0, + 1.0/3.0, 2.0/3.0, 0.0, + 0.0, 2.0/3.0, 0.0, + 0.0, 1.0/3.0, 0.0, + 0.0, 0.0, 1.0/3.0, + 0.0, 0.0, 2.0/3.0, + 2.0/3.0, 0.0, 1.0/3.0, + 1.0/3.0, 0.0, 2.0/3.0, + 0.0, 2.0/3.0, 1.0/3.0, + 0.0, 1.0/3.0, 2.0/3.0, + 1.0/3.0, 1.0/3.0, 0.0, + 1.0/3.0, 0.0, 1.0/3.0, + 1.0/3.0, 1.0/3.0, 1.0/3.0, + 0.0, 1.0/3.0, 1.0/3.0 +}; + +eldefninstruction cg3_3deldefn[] = { + LINE(0,0,1), // Identify line subelement with vertex indices (0,1) + LINE(1,1,2), // Identify line subelement with vertex indices (1,2) + LINE(2,2,0), // Identify line subelement with vertex indices (2,0) + LINE(3,0,3), // Identify line subelement with vertex indices (0,3) + LINE(4,1,3), // Identify line subelement with vertex indices (1,3) + LINE(5,2,3), // Identify line subelement with vertex indices (2,3) + AREA(6,0,1,2), // Identify area subelement with vertex indices (0,1,2) + AREA(7,0,3,1), // Identify area subelement with vertex indices (0,3,1) + AREA(8,1,3,2), // Identify area subelement with vertex indices (1,3,2) + AREA(9,2,3,0), // Identify area subelement with vertex indices (2,3,0) + QUANTITY(0,0,0), // Fetch quantity on vertex 0 + QUANTITY(0,1,0), // Fetch quantity on vertex 1 + QUANTITY(0,2,0), // Fetch quantity on vertex 2 + QUANTITY(0,3,0), // Fetch quantity on vertex 3 + QUANTITY(1,0,0), // Fetch quantity 0 from line 0 + QUANTITY(1,0,1), // Fetch quantity 1 from line 0 + QUANTITY(1,1,0), // Fetch quantity 0 from line 1 + QUANTITY(1,1,1), // Fetch quantity 1 from line 1 + QUANTITY(1,2,0), // Fetch quantity 0 from line 2 + QUANTITY(1,2,1), // Fetch quantity 1 from line 2 + QUANTITY(1,3,0), // Fetch quantity 0 from line 3 + QUANTITY(1,3,1), // Fetch quantity 1 from line 3 + QUANTITY(1,4,0), // Fetch quantity 0 from line 4 + QUANTITY(1,4,1), // Fetch quantity 1 from line 4 + QUANTITY(1,5,0), // Fetch quantity 0 from line 5 + QUANTITY(1,5,1), // Fetch quantity 1 from line 5 + QUANTITY(2,6,0), // Fetch quantity 0 from area 0 + QUANTITY(2,7,0), // Fetch quantity 0 from area 1 + QUANTITY(2,8,0), // Fetch quantity 0 from area 2 + QUANTITY(2,9,0), // Fetch quantity 0 from area 3 + ENDDEFN +}; + +fespace *cg3_3d_lower[] = { + &cg3_2d, + &cg3_1d, + NULL +}; + +fespace cg3_3d = { + .name = "CG3", + .grade = 3, + .shape = cg3_3dshape, + .degree = 3, + .nnodes = 20, + .nsubel = 10, + .nodes = cg3_3dnodes, + .ifn = cg3_3dinterpolate, + .gfn = cg3_3dgrad, + .hfn = cg3_3dhess, + .eldefn = cg3_3deldefn, + .lower = cg3_3d_lower +}; + /* ------------------------------------------------------- * List of finite elements * ------------------------------------------------------- */ @@ -480,10 +854,13 @@ fespace cg2_3d = { fespace *fespaces[] = { &cg1_1d, &cg2_1d, + &cg3_1d, &cg1_2d, &cg2_2d, + &cg3_2d, &cg1_3d, &cg2_3d, + &cg3_3d, NULL }; @@ -510,13 +887,75 @@ fespace *fespace_findlinear(grade g) { #define FETCH(instr) (*(instr++)) +typedef struct { + elementid id; + bool reversed; +} fespacesubelement; + +/** Remaps an edge-local quantity index if the matched line orientation is reversed. */ +static int fespace_orientedquantity(fespace *disc, grade g, fespacesubelement *subel, int sid, int indx) { + int stride = disc->nsubel+1; + if (g!=MESH_GRADE_LINE || !subel[g*stride+sid].reversed) return indx; + + fespace *lower; + if (!fespace_lower(disc, g, &lower)) return indx; + + int nedgeq = lower->shape[MESH_GRADE_LINE]; + if (indx<0 || indx>=nedgeq) return indx; + + return nedgeq-indx-1; +} + +/** Returns the FE-local field index tuple (grade, subelement id, local dof index) for a node. */ +bool fespace_nodefieldindex(fespace *disc, int node, grade *g, int *sid, int *indx) { + if (node<0 || node>=disc->nnodes) return false; + + int k=0; + for (eldefninstruction *instr=disc->eldefn; instr!=NULL && *instr!=ENDDEFN; ) { + eldefninstruction op=FETCH(instr); + switch(op) { + case LINE_OPCODE: + case AREA_OPCODE: + FETCH(instr); // local subelement id + for (int i=0; i<=op; i++) FETCH(instr); // local vertex ids + break; + case QUANTITY_OPCODE: + { + grade qg = FETCH(instr); + int qsid = FETCH(instr); + int qindx = FETCH(instr); + if (k==node) { + if (g) *g=qg; + if (sid) *sid=qsid; + if (indx) *indx=qindx; + return true; + } + k++; + } + break; + default: + UNREACHABLE("Error in finite element definition"); + } + } + + return false; +} + /** Steps through an element definition, generating subelements and identifying quantities */ bool fespace_doftofieldindx(objectfield *field, fespace *disc, int nv, int *vids, fieldindx *findx) { - elementid subel[disc->nsubel+1]; // Element IDs of sub elements + int stride = disc->nsubel+1; + fespacesubelement subel[(disc->grade+1)*stride]; // Element IDs and orientation of subelements int sid, svids[nv], nmatch, k=0; objectsparse *vmatrix[disc->grade+1]; // Vertex->elementid connectivity matrices - for (grade g=0; g<=disc->grade; g++) vmatrix[g]=mesh_addconnectivityelement(field->mesh, g, 0); + for (grade g=0; g<=disc->grade; g++) { + vmatrix[g]=mesh_addconnectivityelement(field->mesh, g, 0); + if (!vmatrix[g] && g>0 && disc->shape[g]>0) { + mesh_addgrade(field->mesh, g); + vmatrix[g]=mesh_addconnectivityelement(field->mesh, g, 0); + } + } + objectsparse *lineconn = mesh_getconnectivityelement(field->mesh, 0, MESH_GRADE_LINE); for (eldefninstruction *instr=disc->eldefn; instr!=NULL && *instr!=ENDDEFN; ) { eldefninstruction op=FETCH(instr); @@ -527,15 +966,31 @@ bool fespace_doftofieldindx(objectfield *field, fespace *disc, int nv, int *vids sid = FETCH(instr); for (int i=0; i<=op; i++) svids[i] = vids[FETCH(instr)]; - if (!mesh_matchelements(vmatrix[1], op, op+1, svids, 1, &nmatch, &subel[sid])) return false; + fespacesubelement *matched = &subel[op*stride+sid]; + matched->id = -1; + if (!mesh_matchelements(vmatrix[op], op, op+1, svids, 1, &nmatch, &matched->id)) return false; + if (nmatch!=1 || matched->id<0) return false; + + matched->reversed=false; + if (op==LINE_OPCODE) { + int nlinev, *linevids; + if (!lineconn || !mesh_getconnectivity(lineconn, matched->id, &nlinev, &linevids)) return false; + if (nlinev!=2) return false; + + if (linevids[0]==svids[1] && linevids[1]==svids[0]) { + matched->reversed=true; + } else if (!(linevids[0]==svids[0] && linevids[1]==svids[1])) { + return false; + } + } } break; case QUANTITY_OPCODE: { findx[k].g=FETCH(instr); int sid=FETCH(instr); - findx[k].id=(findx[k].g==0 ? vids[sid]: subel[sid]); - findx[k].indx=FETCH(instr); + findx[k].id=(findx[k].g==0 ? vids[sid]: subel[findx[k].g*stride+sid].id); + findx[k].indx=fespace_orientedquantity(disc, findx[k].g, subel, sid, FETCH(instr)); k++; } break; @@ -557,9 +1012,28 @@ bool fespace_lower(fespace *disc, grade target, fespace **out) { return false; } +/** Returns the barycentric coordinates of a node in the reference element */ +bool fespace_getnodecoords(fespace *disc, int node, double *lambda) { + if (!disc || !lambda) return false; + if (node<0 || node>=disc->nnodes) return false; + + double l0 = 1.0; + + for (int i=0; igrade; i++) { + double li = disc->nodes[node*disc->grade+i]; + lambda[i+1] = li; + l0 -= li; + } + + lambda[0] = l0; + + return true; +} + /** Constructs a layout matrix that maps element ids (columns) to degree of freedom indices in a field */ bool fespace_layout(objectfield *field, fespace *disc, objectsparse **out) { objectsparse *conn = mesh_getconnectivityelement(field->mesh, 0, disc->grade); + if (!conn) conn = mesh_addconnectivityelement(field->mesh, 0, disc->grade); elementid nel=mesh_nelements(conn); objectsparse *new = object_newsparse(NULL, NULL); @@ -590,7 +1064,10 @@ bool fespace_layout(objectfield *field, fespace *disc, objectsparse **out) { /** @brief Calculates the gradient of the basis functions with respect to the reference coordinates. * @param[in] disc - fespace to query * @param[in] lambda - position in barycentric coordinates - * @param[out] grad - gradient of basis functions with respect to reference coordinates (disc->nnodes x disc->grade) + * @param[out] grad - gradient of basis functions with respect to reference coordinates. + * Layout is column-major by component: + * grad->elements[FESPACE_GRAD_INDEX(disc->nnodes, component, node)]. + * @pre FESPACE_HASGRADIENT(disc) */ void fespace_gradient(fespace *disc, double *lambda, objectmatrix *grad) { int nbary = disc->grade+1; @@ -604,6 +1081,18 @@ void fespace_gradient(fespace *disc, double *lambda, objectmatrix *grad) { } } +/** @brief Calculates the Hessian of the basis functions with respect to the reference coordinates. + * @param[in] disc - fespace to query + * @param[in] lambda - position in barycentric coordinates + * @param[out] hess - Hessian of basis functions with respect to reference coordinates + * in column-major tensor order: + * hess->elements[FESPACE_HESS_INDEX(disc->nnodes, disc->grade, row, col, node)]. + * @pre FESPACE_HASHESSIAN(disc) + */ +void fespace_hessian(fespace *disc, double *lambda, objectmatrix *hess) { + if (disc->hfn) (disc->hfn) (lambda, hess->elements); +} + /* ********************************************************************** * FunctionSpace class * ********************************************************************** */ @@ -626,10 +1115,7 @@ value fespace_constructor(vm *v, int nargs, value *args) { if (d) { objectfespace *obj=objectfespace_new(d); - if (obj) { - out = MORPHO_OBJECT(obj); - morpho_bindobjects(v, 1, &out); - } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + out = morpho_wrapandbind(v, (object *) obj); } else morpho_runtimeerror(v, FNSPC_NOTFOUND, label, MORPHO_GETINTEGERVALUE(grd)); } else morpho_runtimeerror(v, FNSPC_ARGS); @@ -637,6 +1123,16 @@ value fespace_constructor(vm *v, int nargs, value *args) { return out; } +value FiniteElementSpace_count(vm *v, int nargs, value *args) { + objectfespace *slf = MORPHO_GETFESPACE(MORPHO_SELF(args)); + return MORPHO_INTEGER(slf->fespace->nnodes); +} + +value FiniteElementSpace_grade(vm *v, int nargs, value *args) { + objectfespace *slf = MORPHO_GETFESPACE(MORPHO_SELF(args)); + return MORPHO_INTEGER(slf->fespace->grade); +} + value FiniteElementSpace_layout(vm *v, int nargs, value *args) { value out=MORPHO_NIL; objectfespace *slf = MORPHO_GETFESPACE(MORPHO_SELF(args)); @@ -644,16 +1140,70 @@ value FiniteElementSpace_layout(vm *v, int nargs, value *args) { objectfield *field = MORPHO_GETFIELD(MORPHO_GETARG(args, 0)); objectsparse *new; - if (fespace_layout(field, slf->fespace, &new)) { - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); + if (fespace_layout(field, slf->fespace, &new)) out=morpho_wrapandbind(v, (object *) new); + } + return out; +} + +value FiniteElementSpace_nodeelementindex(vm *v, int nargs, value *args) { + value out=MORPHO_NIL; + objectfespace *slf = MORPHO_GETFESPACE(MORPHO_SELF(args)); + + if (nargs==1 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { + int i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + grade g; + int sid, indx; + + if (fespace_nodefieldindex(slf->fespace, i, &g, &sid, &indx)) { + value entries[3] = { MORPHO_INTEGER(g), MORPHO_INTEGER(sid), MORPHO_INTEGER(indx) }; + objecttuple *new = object_newtuple(3, entries); + out=morpho_wrapandbind(v, (object *) new); + } + } + + return out; +} + +value FiniteElementSpace_nodecoords(vm *v, int nargs, value *args) { + value out=MORPHO_NIL; + objectfespace *slf = MORPHO_GETFESPACE(MORPHO_SELF(args)); + fespace *disc = slf->fespace; + int nrows = disc->grade+1; + + if (nargs==0) { + objectmatrix *new = matrix_new(nrows, disc->nnodes, true); + if (!new) return MORPHO_NIL; + + for (int i=0; innodes; i++) { + double lambda[nrows]; + if (!fespace_getnodecoords(disc, i, lambda)) { + object_free((object *) new); + return MORPHO_NIL; + } + matrix_setcolumnptr(new, i, lambda); + } + + out=morpho_wrapandbind(v, (object *) new); + } else if (nargs==1 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { + int i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + double lambda[nrows]; + + if (fespace_getnodecoords(disc, i, lambda)) { + objectmatrix *new = matrix_new(nrows, 1, true); + if (new) matrix_setcolumnptr(new, 0, lambda); + out=morpho_wrapandbind(v, (object *) new); } } + return out; } MORPHO_BEGINCLASS(FiniteElementSpace) -MORPHO_METHOD(FINITEELEMENTSPACE_LAYOUT_METHOD, FiniteElementSpace_layout, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_COUNT_METHOD, FiniteElementSpace_count, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(FINITEELEMENTSPACE_GRADE_METHOD, FiniteElementSpace_grade, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(FINITEELEMENTSPACE_LAYOUT_METHOD, FiniteElementSpace_layout, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(FINITEELEMENTSPACE_NODEELEMENTINDEX_METHOD, FiniteElementSpace_nodeelementindex, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(FINITEELEMENTSPACE_NODECOORDS_METHOD, FiniteElementSpace_nodecoords, BUILTIN_FLAGSEMPTY) MORPHO_ENDCLASS /* ********************************************************************** @@ -663,7 +1213,7 @@ MORPHO_ENDCLASS void fespace_initialize(void) { objectfespacetype=object_addtype(&objectfespacedefn); - builtin_addfunction(FINITEELEMENTSPACE_CLASSNAME, fespace_constructor, BUILTIN_FLAGSEMPTY); + builtin_addfunction(FINITEELEMENTSPACE_CLASSNAME, fespace_constructor, MORPHO_FN_CONSTRUCTOR|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS); objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); diff --git a/src/geometry/fespace.h b/src/geometry/fespace.h index 062e29d49..3aadb1f2b 100644 --- a/src/geometry/fespace.h +++ b/src/geometry/fespace.h @@ -16,6 +16,22 @@ /** @brief Interpolation functions are called to assign weights to the nodes given barycentric coordinates */ typedef void (*interpolationfn) (double *, double *); +/** @brief Gradient callbacks return d Xi[i] / d lambda[j] in column-major order: + * out[FESPACE_GRAD_INDEX(nnodes, j, i)] */ +typedef void (*gradientfn) (double *, double *); + +/** @brief Hessian callbacks return d^2 Xi[i] / d x[row] d x[col] in column-major tensor order: + * out[FESPACE_HESS_INDEX(nnodes, dim, row, col, i)] */ +typedef void (*hessianfn) (double *, double *); + +/** @brief Indexing helpers for derivative callback output layouts */ +#define FESPACE_GRAD_INDEX(nnodes, component, node) ((component)*(nnodes)+(node)) +#define FESPACE_HESS_INDEX(nnodes, dim, row, col, node) ((((col)*(dim))+(row))*(nnodes)+(node)) + +/** @brief Capability helpers for derivative evaluation */ +#define FESPACE_HASGRADIENT(disc) ((disc)->gfn!=NULL) +#define FESPACE_HASHESSIAN(disc) ((disc)->hfn!=NULL) + /** @brief Element definitions comprise a sequence of instructions to map field degrees of freedom to local nodes */ typedef int eldefninstruction; @@ -29,7 +45,8 @@ typedef struct sfespace { int nsubel; /** Number of subelements used by */ double *nodes; /** Node positions */ interpolationfn ifn; /** Interpolation function; receives barycentric coordinates as input and returns weights per node */ - interpolationfn gfn; /** Gradient interpolation function */ + gradientfn gfn; /** Gradient interpolation function in barycentric coordinates */ + hessianfn hfn; /** Hessian interpolation function in reference coordinates */ eldefninstruction *eldefn; /** Element definition */ struct sfespace **lower; /** Discretization to be used for interpolation on lower grades */ } fespace; @@ -58,7 +75,10 @@ typedef struct { #define FINITEELEMENTSPACE_CLASSNAME "FiniteElementSpace" +#define FINITEELEMENTSPACE_GRADE_METHOD "grade" #define FINITEELEMENTSPACE_LAYOUT_METHOD "layout" +#define FINITEELEMENTSPACE_NODEELEMENTINDEX_METHOD "nodeElementIndex" +#define FINITEELEMENTSPACE_NODECOORDS_METHOD "nodeCoords" /* ------------------------------------------------------- * Discretization error messages @@ -78,11 +98,14 @@ fespace *fespace_find(char *name, grade g); fespace *fespace_findlinear(grade g); bool fespace_doftofieldindx(objectfield *field, fespace *disc, int nv, int *vids, fieldindx *findx); +bool fespace_nodefieldindex(fespace *disc, int node, grade *g, int *sid, int *indx); bool fespace_lower(fespace *disc, grade target, fespace **out); +bool fespace_getnodecoords(fespace *disc, int node, double *lambda); bool fespace_layout(objectfield *field, fespace *disc, objectsparse **out); void fespace_gradient(fespace *disc, double *lambda, objectmatrix *grad); +void fespace_hessian(fespace *disc, double *lambda, objectmatrix *hess); void fespace_initialize(void); diff --git a/src/geometry/field.c b/src/geometry/field.c index e59316488..751a92c6a 100644 --- a/src/geometry/field.c +++ b/src/geometry/field.c @@ -11,7 +11,7 @@ #include "morpho.h" #include "classes.h" #include "common.h" -#include "matrix.h" +#include "linalg.h" #include "sparse.h" #include "geometry.h" @@ -114,6 +114,11 @@ objectfield *object_newfield(objectmesh *mesh, value prototype, value fnspc, uns unsigned int dof[ngrades]; // Extract shape from fespace or the provided function space if (MORPHO_ISFESPACE(fnspc)) { fespace *disc = MORPHO_GETFESPACE(fnspc)->fespace; + for (grade g=1; g<=disc->grade; g++) { + if (disc->shape[g]>0 && !mesh_getconnectivityelement(mesh, 0, g)) { + mesh_addgrade(mesh, g); + } + } for (int i=0; i<=disc->grade; i++) dof[i]=disc->shape[i]; for (int i=disc->grade+1; idata.obj, OBJECT_MATRIX); new->data.ncols=1; new->data.nrows=size; + new->data.nvals=1; + new->data.nels=new->data.ncols*new->data.nrows*new->data.nvals; new->data.elements=new->data.matrixdata; if (MORPHO_ISMATRIX(prototype)) { @@ -204,6 +211,7 @@ bool field_applyfunctiontoelements(vm *v, objectmesh *mesh, value fn, value fnsp fespace *disc = MORPHO_GETFESPACE(fnspc)->fespace; objectsparse *conn = mesh_getconnectivityelement(mesh, 0, disc->grade); + if (!conn) conn = mesh_addconnectivityelement(mesh, 0, disc->grade); if (!conn) return false; elementid nel = mesh_nelements(conn); @@ -310,6 +318,8 @@ bool field_addpool(objectfield *f) { m[i].elements=f->data.elements+i*f->psize; m[i].ncols=prototype->ncols; m[i].nrows=prototype->nrows; + m[i].nvals=prototype->nvals; + m[i].nels=m[i].ncols*m[i].nrows*m[i].nvals; } } return true; @@ -380,9 +390,19 @@ bool field_getelementwithindex(objectfield *field, int indx, value *out) { * @param[in] indx - index within the element * @param[out] out - the retrieved index * @return true on success */ +static bool field_validateaccess(objectfield *field, grade grade, elementid el, int indx) { + if (!field) return false; + if (grade<0 || grade>=field->ngrades) return false; + if (el<0) return false; + if (indx<0 || indx>=field->dof[grade]) return false; + return true; +} + bool field_getindex(objectfield *field, grade grade, elementid el, int indx, int *out) { + if (!out || !field_validateaccess(field, grade, el, indx)) return false; + int ix=field->offset[grade]+field->dof[grade]*el+indx; - if (!(ixoffset[grade+1] && indxdof[grade])) return false; + if (!(ixoffset[grade+1])) return false; *out=ix; return true; @@ -413,6 +433,64 @@ bool field_getelementaslist(objectfield *field, grade grade, elementid el, int i return success; } +static bool field_getelementdofs(objectfield *field, fespace *disc, elementid el, fieldindx *findx) { + if (!field || !disc || !findx) return false; + + objectsparse *conn = mesh_getconnectivityelement(field->mesh, 0, disc->grade); + if (!conn) conn = mesh_addconnectivityelement(field->mesh, 0, disc->grade); + if (!conn) return false; + + int nv, *vids; + if (!mesh_getconnectivity(conn, el, &nv, &vids)) return false; + if (nv!=disc->grade+1) return false; + + return fespace_doftofieldindx(field, disc, nv, vids, findx); +} + +bool field_evalelement(objectfield *field, elementid el, double *lambda, value *out) { + if (!field || !lambda || !out) return false; + if (!MORPHO_ISFESPACE(field->fnspc)) return false; + + fespace *disc = MORPHO_GETFESPACE(field->fnspc)->fespace; + fieldindx findx[disc->nnodes]; + if (!field_getelementdofs(field, disc, el, findx)) return false; + + double wts[disc->nnodes]; + disc->ifn(lambda, wts); + + if (MORPHO_ISNIL(field->prototype)) { + double accum = 0.0; + for (int i=0; innodes; i++) { + value q; + double val; + if (!field_getelement(field, findx[i].g, findx[i].id, findx[i].indx, &q)) return false; + if (!morpho_valuetofloat(q, &val)) return false; + accum += wts[i]*val; + } + *out = MORPHO_FLOAT(accum); + return true; + } else if (MORPHO_ISMATRIX(field->prototype)) { + objectmatrix *proto = MORPHO_GETMATRIX(field->prototype); + objectmatrix *accum = matrix_new(proto->nrows, proto->ncols, true); + if (!accum) return false; + + for (int i=0; innodes; i++) { + unsigned int nentries; + double *entries; + if (!field_getelementaslist(field, findx[i].g, findx[i].id, findx[i].indx, &nentries, &entries)) { + object_free((object *) accum); + return false; + } + for (unsigned int j=0; jelements[j] += wts[i]*entries[j]; + } + + *out = MORPHO_OBJECT(accum); + return true; + } + + return false; +} + /** Sets the value of an entry in a field object * @param[in] field - field to use * @param[in] grade - grade to access @@ -485,21 +563,23 @@ unsigned int field_dofforgrade(objectfield *f, grade g) { /** Adds two fields together */ bool field_add(objectfield *left, objectfield *right, objectfield *out) { - return (matrix_add(&left->data, &right->data, &out->data)==MATRIX_OK); + return (matrix_copy(&left->data, &out->data)==LINALGERR_OK && + matrix_axpy(1.0, &right->data, &out->data)==LINALGERR_OK); } /** Subtracts one field from another */ bool field_sub(objectfield *left, objectfield *right, objectfield *out) { - return (matrix_sub(&left->data, &right->data, &out->data)==MATRIX_OK); + return (matrix_copy(&left->data, &out->data)==LINALGERR_OK && + matrix_axpy(-1.0, &right->data, &out->data)==LINALGERR_OK); } /** Accumulate, i.e. a <- a + lambda*b */ bool field_accumulate(objectfield *left, double lambda, objectfield *right) { - return (matrix_accumulate(&left->data, lambda, &right->data)==MATRIX_OK); + return (matrix_axpy(lambda, &right->data, &left->data)==LINALGERR_OK); } bool field_inner(objectfield *left, objectfield *right, double *out) { - return (matrix_inner(&left->data, &right->data, out)==MATRIX_OK); + return (matrix_inner(&left->data, &right->data, out)==LINALGERR_OK); } /** Calls a function fn on every element of a field, optionally with other fields as arguments */ @@ -685,7 +765,7 @@ value Field_assign(vm *v, int nargs, value *args) { } else if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); - if (matrix_copy(b, &a->data)!=MATRIX_OK) morpho_runtimeerror(v, FIELD_INCOMPATIBLEMATRICES); + if (matrix_copy(b, &a->data)!=LINALGERR_OK) morpho_runtimeerror(v, FIELD_INCOMPATIBLEMATRICES); } else morpho_runtimeerror(v, FIELD_ARITHARGS); return MORPHO_NIL; @@ -726,7 +806,7 @@ value Field_addr(vm *v, int nargs, value *args) { if (i==0) { out=MORPHO_SELF(args); } else UNREACHABLE("Right addition to non-zero value."); - } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + } else morpho_runtimeerror(v, LINALG_INVLDARGS); return out; } @@ -808,7 +888,7 @@ value Field_mul(vm *v, int nargs, value *args) { morpho_bindobjects(v, 1, &out); } } - } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + } else morpho_runtimeerror(v, LINALG_INVLDARGS); return out; } @@ -938,12 +1018,103 @@ value Field_mesh(vm *v, int nargs, value *args) { return MORPHO_OBJECT(f->mesh); } +static bool field_readlambda(value arg, int nlambda, double *lambda) { + if (MORPHO_ISLIST(arg)) { + objectlist *list = MORPHO_GETLIST(arg); + if (list_length(list)!=(unsigned int) nlambda) return false; + for (int i=0; inrows!=(unsigned int) nlambda || mat->ncols!=1) return false; + for (int i=0; ielements[i]; + return true; + } + + return false; +} + +value Field_evalelement_method(vm *v, int nargs, value *args) { + value out = MORPHO_NIL; + objectfield *field=MORPHO_GETFIELD(MORPHO_SELF(args)); + if (!MORPHO_ISFESPACE(field->fnspc)) return out; + + fespace *disc = MORPHO_GETFESPACE(field->fnspc)->fespace; + int nlambda = disc->grade+1; + + if (nargs==2 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { + elementid el = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + double lambda[nlambda]; + + if (field_readlambda(MORPHO_GETARG(args, 1), nlambda, lambda) && + field_evalelement(field, el, lambda, &out) && + MORPHO_ISOBJECT(out)) { + morpho_bindobjects(v, 1, &out); + } + } + + return out; +} + +value Field_elementdofs_method(vm *v, int nargs, value *args) { + value out = MORPHO_NIL; + objectfield *field=MORPHO_GETFIELD(MORPHO_SELF(args)); + objectlist *list = NULL; + if (!MORPHO_ISFESPACE(field->fnspc)) return out; + + fespace *disc = MORPHO_GETFESPACE(field->fnspc)->fespace; + if (nargs==1 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { + elementid el = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + fieldindx findx[disc->nnodes]; + if (!field_getelementdofs(field, disc, el, findx)) return out; + + list = object_newlist(0, NULL); + if (!list) goto field_elementdofs_cleanup; + out = MORPHO_OBJECT(list); + + for (int i=0; innodes; i++) { + value entries[3] = { + MORPHO_INTEGER(findx[i].g), + MORPHO_INTEGER(findx[i].id), + MORPHO_INTEGER(findx[i].indx) + }; + objecttuple *tuple = object_newtuple(3, entries); + if (!tuple) goto field_elementdofs_cleanup; + list_append(list, MORPHO_OBJECT(tuple)); + } + + /* Temporarily append a self reference so everything can be bound in one go. */ + list_append(list, MORPHO_OBJECT(list)); + morpho_bindobjects(v, list->val.count, list->val.data); + list->val.count--; + } + + return out; + +field_elementdofs_cleanup: + morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + + if (list) { + for (unsigned int i=0; ival.count; i++) { + value el=list->val.data[i]; + if (MORPHO_ISOBJECT(el)) object_free(MORPHO_GETOBJECT(el)); + } + object_free((object *) list); + } + + return MORPHO_NIL; +} + /** Get the matrix that stores the Field */ value Field_linearize(vm *v, int nargs, value *args) { objectfield *f=MORPHO_GETFIELD(MORPHO_SELF(args)); value out = MORPHO_NIL; - objectmatrix *m=object_clonematrix(&f->data); + objectmatrix *m=matrix_clone(&f->data); if (m) { out = MORPHO_OBJECT(m); morpho_bindobjects(v, 1, &out); @@ -961,29 +1132,31 @@ value Field_unsafelinearize(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Field) -MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Field_getindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Field_setindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Field_enumerate, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_COUNT_METHOD, Field_count, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ASSIGN_METHOD, Field_assign, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ADD_METHOD, Field_add, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ADDR_METHOD, Field_addr, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SUB_METHOD, Field_sub, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SUBR_METHOD, Field_subr, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ACC_METHOD, Field_acc, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_MUL_METHOD, Field_mul, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_MULR_METHOD, Field_mul, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_DIV_METHOD, Field_div, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_INNER_METHOD, Field_inner, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FIELD_OP_METHOD, Field_op, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Field_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Field_clone, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FIELD_SHAPE_METHOD, Field_shape, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FIELD_FESPACE_METHOD, Field_fnspace, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FIELD_PROTOTYPE_METHOD, Field_prototype, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FIELD_MESH_METHOD, Field_mesh, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FIELD_LINEARIZE_METHOD, Field_linearize, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FIELD__LINEARIZE_METHOD, Field_unsafelinearize, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Field_getindex, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Field_setindex, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Field_enumerate, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_COUNT_METHOD, Field_count, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_ASSIGN_METHOD, Field_assign, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_ADD_METHOD, Field_add, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_ADDR_METHOD, Field_addr, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_SUB_METHOD, Field_sub, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_SUBR_METHOD, Field_subr, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_ACC_METHOD, Field_acc, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_MUL_METHOD, Field_mul, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_MULR_METHOD, Field_mul, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_DIV_METHOD, Field_div, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MATRIX_INNER_METHOD, Field_inner, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD(FIELD_OP_METHOD, Field_op, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Field_print, MORPHO_FN_IO), +MORPHO_METHOD(MORPHO_CLONE_METHOD, Field_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FIELD_SHAPE_METHOD, Field_shape, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(FIELD_FESPACE_METHOD, Field_fnspace, MORPHO_FN_PUREFN), +MORPHO_METHOD(FIELD_PROTOTYPE_METHOD, Field_prototype, MORPHO_FN_PUREFN), +MORPHO_METHOD(FIELD_MESH_METHOD, Field_mesh, MORPHO_FN_PUREFN), +MORPHO_METHOD(FIELD_EVALELEMENT_METHOD, Field_evalelement_method, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FIELD_ELEMENTDOFS_METHOD, Field_elementdofs_method, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FIELD_LINEARIZE_METHOD, Field_linearize, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(FIELD__LINEARIZE_METHOD, Field_unsafelinearize, MORPHO_FN_PUREFN) MORPHO_ENDCLASS /* ********************************************************************** @@ -996,7 +1169,7 @@ void field_initialize(void) { field_gradeoption=builtin_internsymbolascstring(FIELD_GRADEOPTION); field_functionspaceoption=builtin_internsymbolascstring(FIELD_FESPACEOPTION); - builtin_addfunction(FIELD_CLASSNAME, field_constructor, BUILTIN_FLAGSEMPTY); + builtin_addfunction(FIELD_CLASSNAME, field_constructor, MORPHO_FN_CONSTRUCTOR|MORPHO_FN_ALLOCATES|MORPHO_FN_REENTRANT|MORPHO_FN_THROWS); objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); diff --git a/src/geometry/field.h b/src/geometry/field.h index 93ee56f03..282871b59 100644 --- a/src/geometry/field.h +++ b/src/geometry/field.h @@ -12,7 +12,7 @@ #include "object.h" #include "mesh.h" -#include "matrix.h" +#include "linalg.h" #include /* ------------------------------------------------------- @@ -72,9 +72,11 @@ extern value field_gradeoption; #define FIELD_OP_METHOD "op" #define FIELD_SHAPE_METHOD "shape" -#define FIELD_FESPACE_METHOD "finiteelementspace" +#define FIELD_FESPACE_METHOD "finiteElementSpace" #define FIELD_PROTOTYPE_METHOD "prototype" #define FIELD_MESH_METHOD "mesh" +#define FIELD_EVALELEMENT_METHOD "evalElement" +#define FIELD_ELEMENTDOFS_METHOD "elementDofs" #define FIELD_LINEARIZE_METHOD "linearize" #define FIELD__LINEARIZE_METHOD "__linearize" @@ -116,6 +118,7 @@ bool field_getelement(objectfield *field, grade grade, elementid el, int indx, v bool field_getelementwithindex(objectfield *field, int indx, value *out); bool field_getindex(objectfield *field, grade grade, elementid el, int indx, int *out); bool field_getelementaslist(objectfield *field, grade grade, elementid el, int indx, unsigned int *nentries, double **out); +bool field_evalelement(objectfield *field, elementid el, double *lambda, value *out); bool field_setelement(objectfield *field, grade grade, elementid el, int indx, value val); bool field_setelementwithindex(objectfield *field, int ix, value val); diff --git a/src/geometry/functional.c b/src/geometry/functional.c index ab571011b..3bb202de1 100644 --- a/src/geometry/functional.c +++ b/src/geometry/functional.c @@ -9,6 +9,7 @@ #include #include +#include #include "functional.h" #include "morpho.h" @@ -17,7 +18,7 @@ #include "threadpool.h" -#include "matrix.h" +#include "linalg.h" #include "sparse.h" #include "geometry.h" @@ -29,6 +30,11 @@ value functional_gradeproperty; value functional_fieldproperty; //static value functional_functionproperty; +typedef struct jumpref_s jumpref; +static bool jump_getadjacentparents(jumpref *ref, elementid interfaceid, int *nparents, int **parents); +static bool jump_startfn(vm *v, functional_mapinfo *info); +static void jump_orderparents(int *parents, elementid *plusid, elementid *minusid); + /* ********************************************************************** * Utility functions * ********************************************************************** */ @@ -59,6 +65,8 @@ static void functional_clearmapinfo(functional_mapinfo *info) { info->id=0; info->integrand=NULL; info->grad=NULL; + info->fieldgrad=NULL; + info->start=NULL; info->dependencies=NULL; info->cloneref=NULL; info->freeref=NULL; @@ -93,6 +101,11 @@ bool functional_validateargs(vm *v, int nargs, value *args, functional_mapinfo * return false; } +bool functional_startmap(vm *v, functional_mapinfo *info) { + if (!info->start) return true; + return (*info->start) (v, info); +} + /* ********************************************************************** * Common routines @@ -154,12 +167,12 @@ bool functional_symmetrysumforces(objectmesh *mesh, objectmatrix *frc) { double *fi, *fj, fsum[mesh->dim]; while (sparsedok_loop(&s->dok, &ctr, &i, &j)) { - if (matrix_getcolumn(frc, i, &fi) && - matrix_getcolumn(frc, j, &fj)) { + if (matrix_getcolumnptr(frc, i, &fi)==LINALGERR_OK && + matrix_getcolumnptr(frc, j, &fj)==LINALGERR_OK) { for (unsigned int k=0; kdim; k++) fsum[k]=fi[k]+fj[k]; - matrix_setcolumn(frc, i, fsum); - matrix_setcolumn(frc, j, fsum); + if (matrix_setcolumnptr(frc, i, fsum)!=LINALGERR_OK) return false; + if (matrix_setcolumnptr(frc, j, fsum)!=LINALGERR_OK) return false; } } } @@ -279,7 +292,7 @@ bool functional_mapintegrandX(vm *v, functional_mapinfo *info, value *out) { /* Create the output matrix */ if (n>0) { - new=object_newmatrix(1, n, true); + new=matrix_new(1, n, true); if (!new) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return false; } } @@ -357,7 +370,7 @@ bool functional_mapgradientX(vm *v, functional_mapinfo *info, value *out) { /* Create the output matrix */ if (n>0) { - frc=object_newmatrix(mesh->vert->nrows, mesh->vert->ncols, true); + frc=matrix_new(mesh->vert->nrows, mesh->vert->ncols, true); if (!frc) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return false; } } @@ -566,7 +579,7 @@ bool functional_mapnumericalgradientX(vm *v, functional_mapinfo *info, value *ou /* Create the output matrix */ if (n>0) { - frc=object_newmatrix(mesh->vert->nrows, mesh->vert->ncols, true); + frc=matrix_new(mesh->vert->nrows, mesh->vert->ncols, true); if (!frc) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return false; } } @@ -1047,7 +1060,7 @@ bool functional_mapintegrand(vm *v, functional_mapinfo *info, value *out) { /* Create output matrix */ if (task[0].nel>0) { - new=object_newmatrix(1, task[0].nel, true); + new=matrix_new(1, task[0].nel, true); if (!new) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return false; } } @@ -1093,7 +1106,7 @@ bool functional_mapgradient(vm *v, functional_mapinfo *info, value *out) { /* Create output matrix */ for (int i=0; imesh->vert->nrows, info->mesh->vert->ncols, true); + new[i]=matrix_new(info->mesh->vert->nrows, info->mesh->vert->ncols, true); if (!new[i]) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); goto functional_mapgradient_cleanup; } task[i].mapfn=(functional_mapfn *) info->grad; @@ -1103,7 +1116,7 @@ bool functional_mapgradient(vm *v, functional_mapinfo *info, value *out) { functional_parallelmap(ntask, task); /* Then add up all the matrices */ - for (int i=1; isym==SYMMETRY_ADD) functional_symmetrysumforces(info->mesh, new[0]); @@ -1195,12 +1208,12 @@ bool functional_mapnumericalgradient(vm *v, functional_mapinfo *info, value *out for (int i=0; imesh->vert->nrows, info->mesh->vert->ncols, true); + new[i]=matrix_new(info->mesh->vert->nrows, info->mesh->vert->ncols, true); if (!new[i]) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); goto functional_mapgradient_cleanup; } // Clone the vertex matrix for each thread meshclones[i]=*info->mesh; - meshclones[i].vert=object_clonematrix(info->mesh->vert); + meshclones[i].vert=matrix_clone(info->mesh->vert); task[i].mesh=&meshclones[i]; task[i].ref=(void *) info; // Use this to pass the info structure @@ -1211,7 +1224,7 @@ bool functional_mapnumericalgradient(vm *v, functional_mapinfo *info, value *out functional_parallelmap(ntask, task); /* Then add up all the matrices */ - for (int i=1; idata, &new[1]->data, &new[0]->data); + for (int i=1; idata, &new[0]->data); // TODO: Use symmetry actions //if (info->sym==SYMMETRY_ADD) functional_symmetrysumforces(info->mesh, new[0]); @@ -1314,13 +1327,52 @@ bool functional_numericalfieldgrad(vm *v, objectmesh *mesh, elementid eid, objec return true; } +/** Computes the field gradient of element eid with respect to a single field dof. */ +bool functional_numericalfieldgradentry(vm *v, objectmesh *mesh, elementid eid, objectfield *field, grade g, elementid i, int indx, int nv, int *vid, functional_integrand *integrand, void *ref, objectfield *grad) { + double fr, fl, eps=1e-6; + unsigned int nentries; + double *entry, *gentry; + + if (!field_getelementaslist(field, g, i, indx, &nentries, &entry)) return false; + if (!field_getelementaslist(grad, g, i, indx, &nentries, &gentry)) return false; + + for (unsigned int j=0; jinfo->g==0 ? 1 : 0), *vid=(tref->info->g==0 ? &remoteid : NULL); + + if (tref->conn) { + if (!sparseccs_getrowindices(&tref->conn->ccs, remoteid, &nv, &vid)) return false; + } + + return functional_numericalfieldgradentry(v, tref->info->mesh, remoteid, tref->field, g, i, indx, nv, vid, tref->integrand, tref->ref, grad); +} + /** Computes the gradient of element id with respect to its constituent vertices and any dependencies */ bool functional_numericalfieldgradientmapfn(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, void *ref, void *out) { functional_numericalfieldgradientref *tref=(functional_numericalfieldgradientref *) ref; @@ -1331,13 +1383,41 @@ bool functional_numericalfieldgradientmapfn(vm *v, objectmesh *mesh, elementid i if (fespace_doftofieldindx(tref->field, tref->disc, nv, vid, findx)) { for (int k=0; kfield, findx[k].g, findx[k].id, nv, vid, tref->integrand, tref->ref, out)) return false; + if (!functional_numericalfieldgradentry(v, mesh, id, tref->field, findx[k].g, findx[k].id, findx[k].indx, nv, vid, tref->integrand, tref->ref, out)) return false; + + if (tref->info->dependencies) { + varray_elementid dependencies; + varray_elementidinit(&dependencies); + if ((tref->info->dependencies)(tref->info, id, &dependencies)) { + for (int j=0; jfield, MESH_GRADE_VERTEX, vid[k], nv, vid, tref->integrand, tref->ref, out)) return false; + + if (tref->info->dependencies) { + varray_elementid dependencies; + varray_elementidinit(&dependencies); + if ((tref->info->dependencies)(tref->info, id, &dependencies)) { + for (int j=0; jcloneref) { tref[i].ref=(info->cloneref) (info->ref, info->field, fieldclones[i]); } else UNREACHABLE("Functional calls numericalfieldgradient but doesn't provide cloneref"); + tref[i].info=info; tref[i].integrand=info->integrand; tref[i].field=fieldclones[i]; + tref[i].conn=mesh_getconnectivityelement(info->mesh, 0, info->g); tref[i].disc=NULL; if (MORPHO_ISFESPACE(tref[i].field->fnspc)) { tref[i].disc=MORPHO_GETFESPACE(tref[i].field->fnspc)->fespace; @@ -1394,7 +1476,7 @@ bool functional_mapnumericalfieldgradient(vm *v, functional_mapinfo *info, value functional_parallelmap(ntask, task); /* Then add up all the fields */ - for (int i=1; idata, &new[i]->data, &new[0]->data); + for (int i=1; idata, &new[0]->data); success=true; @@ -1420,6 +1502,159 @@ bool functional_mapnumericalfieldgradient(vm *v, functional_mapinfo *info, value return success; } +typedef struct { + functional_mapinfo *info; + objectfield *field; + fespace *disc; + objectsparse *conn; + objectsparse *parentvertices; + jumpref *ref; +} jump_numericalfieldgradientref; + +static bool jump_getelementvertices(objectsparse *conn, grade g, elementid id, int *nv, int **vid) { + if (conn) return sparseccs_getrowindices(&conn->ccs, id, nv, vid); + if (g==0) { + *nv=1; + *vid=&id; + return true; + } + return false; +} + +static bool jump_collectparentfieldentries(jump_numericalfieldgradientref *tref, elementid interfaceid, fieldindx *findxout, int *nentries) { + jumpref *ref=tref->ref; + int nparents=0, *parents=NULL; + int plusnv=0, minusnv=0, *plusvid=NULL, *minusvid=NULL; + + *nentries=0; + if (!jump_getadjacentparents(ref, interfaceid, &nparents, &parents)) return false; + if (nparents!=2) return true; + + elementid plusid, minusid; + jump_orderparents(parents, &plusid, &minusid); + + if (!mesh_getconnectivity(tref->parentvertices, plusid, &plusnv, &plusvid)) return false; + if (!mesh_getconnectivity(tref->parentvertices, minusid, &minusnv, &minusvid)) return false; + + fieldindx findx[tref->disc->nnodes]; + if (!fespace_doftofieldindx(tref->field, tref->disc, plusnv, plusvid, findx)) return false; + for (int i=0; idisc->nnodes; i++) { + bool found=false; + for (int j=0; j<*nentries; j++) { + if (findxout[j].g==findx[i].g && findxout[j].id==findx[i].id && findxout[j].indx==findx[i].indx) { found=true; break; } + } + if (!found) { + findxout[*nentries]=findx[i]; + (*nentries)++; + } + } + + if (!fespace_doftofieldindx(tref->field, tref->disc, minusnv, minusvid, findx)) return false; + for (int i=0; idisc->nnodes; i++) { + bool found=false; + for (int j=0; j<*nentries; j++) { + if (findxout[j].g==findx[i].g && findxout[j].id==findx[i].id && findxout[j].indx==findx[i].indx) { found=true; break; } + } + if (!found) { + findxout[*nentries]=findx[i]; + (*nentries)++; + } + } + + return true; +} + +static bool jump_numericalfieldgradientmapfn(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, void *ref, void *out) { + jump_numericalfieldgradientref *tref=(jump_numericalfieldgradientref *) ref; + fieldindx findx[2*tref->disc->nnodes]; + int nentries=0; + + if (!jump_collectparentfieldentries(tref, id, findx, &nentries)) return false; + + for (int k=0; kfield, findx[k].g, findx[k].id, findx[k].indx, nv, vid, tref->info->integrand, tref->ref, out)) return false; + + if (tref->info->dependencies) { + varray_elementid dependencies; + varray_elementidinit(&dependencies); + if ((tref->info->dependencies)(tref->info, id, &dependencies)) { + for (int j=0; jconn, tref->info->g, dependencies.data[j], &rnv, &rvid)) { + varray_elementidclear(&dependencies); + return false; + } + if (!functional_numericalfieldgradentry(v, mesh, dependencies.data[j], tref->field, findx[k].g, findx[k].id, findx[k].indx, rnv, rvid, tref->info->integrand, tref->ref, out)) { + varray_elementidclear(&dependencies); + return false; + } + } + } + varray_elementidclear(&dependencies); + } + } + + return true; +} + +static bool functional_mapjumpnumericalfieldgradient(vm *v, functional_mapinfo *info, objectsparse *parentvertices, void *baseref, value *out) { + int success=false; + int ntask=morpho_threadnumber(); + if (ntask<1) ntask=1; + functional_task task[ntask]; + + varray_elementid imageids; + varray_elementidinit(&imageids); + + objectfield *new[ntask]; + objectfield *fieldclones[ntask]; + jump_numericalfieldgradientref tref[ntask]; + for (int i=0; imesh, info->field->prototype, info->field->fnspc, info->field->dof); + if (!new[i]) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); goto functional_mapjumpfieldgradient_cleanup; } + field_zero(new[i]); + + fieldclones[i]=field_clone(info->field); + tref[i].field=fieldclones[i]; + tref[i].info=info; + tref[i].conn=mesh_getconnectivityelement(info->mesh, 0, info->g); + tref[i].parentvertices=parentvertices; + tref[i].ref=(jumpref *) ((info->cloneref) ? (info->cloneref)(baseref, info->field, fieldclones[i]) : baseref); + if (!tref[i].ref) goto functional_mapjumpfieldgradient_cleanup; + tref[i].disc=NULL; + if (MORPHO_ISFESPACE(tref[i].field->fnspc)) tref[i].disc=MORPHO_GETFESPACE(tref[i].field->fnspc)->fespace; + if (!tref[i].disc) goto functional_mapjumpfieldgradient_cleanup; + + task[i].ref=(void *) &tref[i]; + task[i].mapfn=jump_numericalfieldgradientmapfn; + task[i].result=(void *) new[i]; + } + + functional_parallelmap(ntask, task); + + for (int i=1; idata, &new[0]->data);; + + success=true; + *out=MORPHO_OBJECT(new[0]); + +functional_mapjumpfieldgradient_cleanup: + for (int i=0; ifreeref && tref[i].ref) (info->freeref)(tref[i].ref); + else if (info->cloneref && tref[i].ref) MORPHO_FREE(tref[i].ref); + object_free((object *) fieldclones[i]); + if (i>0 && new[i]) object_free((object *) new[i]); + } + functional_cleanuptasks(v, ntask, task); + varray_elementidclear(&imageids); + return success; +} + /* ---------------------------- * Map numerical hessians * ---------------------------- */ @@ -1561,7 +1796,7 @@ bool functional_mapnumericalhessian(vm *v, functional_mapinfo *info, value *out) // Clone the vertex matrix for each thread meshclones[i]=*info->mesh; - meshclones[i].vert=object_clonematrix(info->mesh->vert); + meshclones[i].vert=matrix_clone(info->mesh->vert); if (!meshclones[i].vert) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); goto functional_maphessian_cleanup; } task[i].mesh=&meshclones[i]; @@ -1713,7 +1948,7 @@ bool functional_elementgradient(vm *v, objectmesh *mesh, grade g, elementid id, bool length_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, void *ref, double *out) { if (nv!=2) return false; double *x[nv], s0[mesh->dim]; - for (int j=0; jvert, vid[j], &x[j]); + for (int j=0; jvert, vid[j], &x[j]); functional_vecsub(mesh->dim, x[1], x[0], s0); @@ -1724,14 +1959,14 @@ bool length_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, v /** Calculate scaled gradient */ bool length_gradient_scale(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, void *ref, objectmatrix *frc, double scale) { double *x[nv], s0[mesh->dim], norm; - for (int j=0; jvert, vid[j], &x[j]); + for (int j=0; jvert, vid[j], &x[j]); functional_vecsub(mesh->dim, x[1], x[0], s0); norm=functional_vecnorm(mesh->dim, s0); if (normdim], normcx; - for (int j=0; jvert, vid[j], &x[j]); + for (int j=0; jvert, vid[j], &x[j]); if (mesh->dim==2) { functional_veccross2d(x[0], x[1], cx); @@ -1783,7 +2018,7 @@ bool areaenclosed_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int * bool areaenclosed_gradient(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, void *ref, objectmatrix *frc) { double *x[nv], cx[3], s[3]; double norm; - for (int j=0; jvert, vid[j], &x[j]); + for (int j=0; jvert, vid[j], &x[j]); if (mesh->dim==3) { functional_veccross(x[0], x[1], cx); @@ -1791,10 +2026,10 @@ bool areaenclosed_gradient(vm *v, objectmesh *mesh, elementid id, int nv, int *v if (normdim==2) { functional_veccross2d(x[0], x[1], cx); @@ -1812,12 +2047,12 @@ FUNCTIONAL_TOTAL(AreaEnclosed, MESH_GRADE_LINE, areaenclosed_integrand) FUNCTIONAL_HESSIAN(AreaEnclosed, MESH_GRADE_LINE, areaenclosed_integrand) MORPHO_BEGINCLASS(AreaEnclosed) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, AreaEnclosed_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, AreaEnclosed_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRANDFORELEMENT_METHOD, AreaEnclosed_integrandForElement, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, AreaEnclosed_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, AreaEnclosed_hessian, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, AreaEnclosed_total, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, AreaEnclosed_init, MORPHO_FN_MUTATES), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, AreaEnclosed_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_INTEGRANDFORELEMENT_METHOD, AreaEnclosed_integrandForElement, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, AreaEnclosed_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, AreaEnclosed_hessian, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, AreaEnclosed_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -1829,7 +2064,7 @@ bool area_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, voi if (nv!=3) return false; double *x[nv], s0[3], s1[3], cx[3]; for (int j=0; j<3; j++) { s0[j]=0; s1[j]=0; cx[j]=0; } - for (int j=0; jvert, vid[j], &x[j]); + for (int j=0; jvert, vid[j], &x[j]); functional_vecsub(mesh->dim, x[1], x[0], s0); functional_vecsub(mesh->dim, x[2], x[1], s1); @@ -1845,7 +2080,7 @@ bool area_gradient_scale(vm *v, objectmesh *mesh, elementid id, int nv, int *vid double *x[nv], s0[3], s1[3], s01[3], s010[3], s011[3]; double norm; for (int j=0; j<3; j++) { s0[j]=0; s1[j]=0; s01[j]=0; s010[j]=0; s011[j]=0; } - for (int j=0; jvert, vid[j], &x[j])) return false; + for (int j=0; jvert, vid[j], &x[j])!=LINALGERR_OK) return false; functional_vecsub(mesh->dim, x[1], x[0], s0); functional_vecsub(mesh->dim, x[2], x[1], s1); @@ -1857,12 +2092,12 @@ bool area_gradient_scale(vm *v, objectmesh *mesh, elementid id, int nv, int *vid functional_veccross(s01, s0, s010); functional_veccross(s01, s1, s011); - matrix_addtocolumn(frc, vid[0], 0.5/norm*scale, s011); - matrix_addtocolumn(frc, vid[2], 0.5/norm*scale, s010); + if (matrix_addtocolumnptr(frc, vid[0], 0.5/norm*scale, s011)!=LINALGERR_OK) return false; + if (matrix_addtocolumnptr(frc, vid[2], 0.5/norm*scale, s010)!=LINALGERR_OK) return false; functional_vecadd(mesh->dim, s010, s011, s0); - matrix_addtocolumn(frc, vid[1], -0.5/norm*scale, s0); + if (matrix_addtocolumnptr(frc, vid[1], -0.5/norm*scale, s0)!=LINALGERR_OK) return false; return true; } @@ -1880,12 +2115,12 @@ FUNCTIONAL_TOTAL(Area, MESH_GRADE_AREA, area_integrand) FUNCTIONAL_HESSIAN(Area, MESH_GRADE_AREA, area_integrand) MORPHO_BEGINCLASS(Area) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Area_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, Area_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRANDFORELEMENT_METHOD, Area_integrandForElement, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, Area_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, Area_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, Area_hessian, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Area_init, MORPHO_FN_MUTATES), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, Area_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_INTEGRANDFORELEMENT_METHOD, Area_integrandForElement, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, Area_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, Area_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, Area_hessian, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -1895,7 +2130,7 @@ MORPHO_ENDCLASS /** Calculate enclosed volume */ bool volumeenclosed_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, void *ref, double *out) { double *x[nv], cx[mesh->dim]; - for (int j=0; jvert, vid[j], &x[j])) return false; + for (int j=0; jvert, vid[j], &x[j])!=LINALGERR_OK) return false; functional_veccross(x[0], x[1], cx); @@ -1906,7 +2141,7 @@ bool volumeenclosed_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int /** Calculate gradient */ bool volumeenclosed_gradient(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, void *ref, objectmatrix *frc) { double *x[nv], cx[mesh->dim], dot; - for (int j=0; jvert, vid[j], &x[j]); + for (int j=0; jvert, vid[j], &x[j])!=LINALGERR_OK) return false; functional_veccross(x[0], x[1], cx); dot=functional_vecdot(mesh->dim, cx, x[2]); @@ -1917,13 +2152,13 @@ bool volumeenclosed_gradient(vm *v, objectmesh *mesh, elementid id, int nv, int dot/=fabs(dot); - matrix_addtocolumn(frc, vid[2], dot/6.0, cx); + if (matrix_addtocolumnptr(frc, vid[2], dot/6.0, cx)!=LINALGERR_OK) return false; functional_veccross(x[1], x[2], cx); - matrix_addtocolumn(frc, vid[0], dot/6.0, cx); + if (matrix_addtocolumnptr(frc, vid[0], dot/6.0, cx)!=LINALGERR_OK) return false; functional_veccross(x[2], x[0], cx); - matrix_addtocolumn(frc, vid[1], dot/6.0, cx); + if (matrix_addtocolumnptr(frc, vid[1], dot/6.0, cx)!=LINALGERR_OK) return false; return true; } @@ -1935,11 +2170,11 @@ FUNCTIONAL_TOTAL(VolumeEnclosed, MESH_GRADE_AREA, volumeenclosed_integrand) FUNCTIONAL_HESSIAN(VolumeEnclosed, MESH_GRADE_AREA, volumeenclosed_integrand) MORPHO_BEGINCLASS(VolumeEnclosed) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, VolumeEnclosed_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, VolumeEnclosed_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, VolumeEnclosed_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, VolumeEnclosed_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, VolumeEnclosed_hessian, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, VolumeEnclosed_init, MORPHO_FN_MUTATES), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, VolumeEnclosed_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, VolumeEnclosed_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, VolumeEnclosed_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, VolumeEnclosed_hessian, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -1949,7 +2184,7 @@ MORPHO_ENDCLASS /** Calculate enclosed volume */ bool volume_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, void *ref, double *out) { double *x[nv], s10[mesh->dim], s20[mesh->dim], s30[mesh->dim], cx[mesh->dim]; - for (int j=0; jvert, vid[j], &x[j]); + for (int j=0; jvert, vid[j], &x[j]); functional_vecsub(mesh->dim, x[1], x[0], s10); functional_vecsub(mesh->dim, x[2], x[0], s20); @@ -1965,7 +2200,7 @@ bool volume_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, v bool volume_gradient_scale(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, void *ref, objectmatrix *frc, double scale) { double *x[nv], s10[mesh->dim], s20[mesh->dim], s30[mesh->dim]; double s31[mesh->dim], s21[mesh->dim], cx[mesh->dim], uu; - for (int j=0; jvert, vid[j], &x[j]); + for (int j=0; jvert, vid[j], &x[j]); functional_vecsub(mesh->dim, x[1], x[0], s10); functional_vecsub(mesh->dim, x[2], x[0], s20); @@ -1977,16 +2212,16 @@ bool volume_gradient_scale(vm *v, objectmesh *mesh, elementid id, int nv, int *v uu=functional_vecdot(mesh->dim, s10, cx); uu=(uu>0 ? 1.0 : -1.0); - matrix_addtocolumn(frc, vid[1], uu/6.0*scale, cx); + if (matrix_addtocolumnptr(frc, vid[1], uu/6.0*scale, cx)!=LINALGERR_OK) return false; functional_veccross(s31, s21, cx); - matrix_addtocolumn(frc, vid[0], uu/6.0*scale, cx); + if (matrix_addtocolumnptr(frc, vid[0], uu/6.0*scale, cx)!=LINALGERR_OK) return false; functional_veccross(s30, s10, cx); - matrix_addtocolumn(frc, vid[2], uu/6.0*scale, cx); + if (matrix_addtocolumnptr(frc, vid[2], uu/6.0*scale, cx)!=LINALGERR_OK) return false; functional_veccross(s10, s20, cx); - matrix_addtocolumn(frc, vid[3], uu/6.0*scale, cx); + if (matrix_addtocolumnptr(frc, vid[3], uu/6.0*scale, cx)!=LINALGERR_OK) return false; return true; } @@ -2003,11 +2238,11 @@ FUNCTIONAL_TOTAL(Volume, MESH_GRADE_VOLUME, volume_integrand) FUNCTIONAL_HESSIAN(Volume, MESH_GRADE_VOLUME, volume_integrand) MORPHO_BEGINCLASS(Volume) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Volume_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, Volume_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, Volume_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, Volume_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, Volume_hessian, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Volume_init, MORPHO_FN_MUTATES), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, Volume_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, Volume_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, Volume_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, Volume_hessian, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -2034,7 +2269,7 @@ bool scalarpotential_integrand(vm *v, objectmesh *mesh, elementid id, int nv, in value args[mesh->dim]; value ret; - matrix_getcolumn(mesh->vert, id, &x); + if (matrix_getcolumnptr(mesh->vert, id, &x)!=LINALGERR_OK) return false; for (int i=0; idim; i++) args[i]=MORPHO_FLOAT(x[i]); if (morpho_call(v, fn, mesh->dim, args, &ret)) { @@ -2051,7 +2286,7 @@ bool scalarpotential_gradient(vm *v, objectmesh *mesh, elementid id, int nv, int value args[mesh->dim]; value ret; - matrix_getcolumn(mesh->vert, id, &x); + if (matrix_getcolumnptr(mesh->vert, id, &x)!=LINALGERR_OK) return false; for (int i=0; idim; i++) args[i]=MORPHO_FLOAT(x[i]); if (morpho_call(v, fn, mesh->dim, args, &ret)) { @@ -2059,7 +2294,7 @@ bool scalarpotential_gradient(vm *v, objectmesh *mesh, elementid id, int nv, int objectmatrix *vf=MORPHO_GETMATRIX(ret); if (vf->nrows*vf->ncols==frc->nrows) { - return matrix_addtocolumn(frc, id, 1.0, vf->elements); + return (matrix_addtocolumnptr(frc, id, 1.0, vf->elements)==LINALGERR_OK); } } } @@ -2129,11 +2364,11 @@ value ScalarPotential_gradient(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(ScalarPotential) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, ScalarPotential_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, ScalarPotential_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, ScalarPotential_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, ScalarPotential_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, ScalarPotential_hessian, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, ScalarPotential_init, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, ScalarPotential_integrand, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, ScalarPotential_gradient, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, ScalarPotential_total, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, ScalarPotential_hessian, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -2157,7 +2392,7 @@ void linearelasticity_calculategram(objectmatrix *vert, int dim, int nv, int *vi double *x[nv], // Positions of vertices s[gdim][nv]; // Side vectors - for (int j=0; j for (int i=0; ielements[i+j*gdim]=functional_vecdot(dim, s[i], s[j]); @@ -2180,16 +2415,17 @@ bool linearelasticity_integrand(vm *v, objectmesh *mesh, elementid id, int nv, i linearelasticity_calculategram(info->refmesh->vert, mesh->dim, nv, vid, &gramref); linearelasticity_calculategram(mesh->vert, mesh->dim, nv, vid, &gramdef); - if (matrix_inverse(&gramref, &q)!=MATRIX_OK) return false; - if (matrix_mul(&gramdef, &q, &r)!=MATRIX_OK) return false; + if (matrix_copy(&gramref, &q)!=LINALGERR_OK) return false; + if (matrix_inverse(&q)!=LINALGERR_OK) return false; + if (matrix_mul(&gramdef, &q, &r)!=LINALGERR_OK) return false; - matrix_identity(&cg); + if (matrix_identity(&cg)!=LINALGERR_OK) return false; matrix_scale(&cg, -0.5); - matrix_accumulate(&cg, 0.5, &r); + matrix_axpy(0.5, &r, &cg); // y <- alpha*x + y double trcg=0.0, trcgcg=0.0; matrix_trace(&cg, &trcg); - + matrix_mul(&cg, &cg, &r); matrix_trace(&r, &trcgcg); @@ -2302,10 +2538,10 @@ value LinearElasticity_gradient(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(LinearElasticity) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LinearElasticity_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, LinearElasticity_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, LinearElasticity_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, LinearElasticity_gradient, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LinearElasticity_init, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, LinearElasticity_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, LinearElasticity_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, LinearElasticity_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -2515,10 +2751,10 @@ FUNCTIONAL_METHOD(Hydrogel, integrand, (ref.grade), hydrogelref, hydrogel_prepar FUNCTIONAL_METHOD(Hydrogel, total, (ref.grade), hydrogelref, hydrogel_prepareref, functional_sumintegrand, hydrogel_integrand, NULL, HYDROGEL_PRP, SYMMETRY_NONE) MORPHO_BEGINCLASS(Hydrogel) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Hydrogel_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, Hydrogel_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, Hydrogel_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, Hydrogel_gradient, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Hydrogel_init, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, Hydrogel_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, Hydrogel_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, Hydrogel_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -2559,7 +2795,9 @@ bool equielement_prepareref(objectinstance *self, objectmesh *mesh, grade g, obj MORPHO_ISMATRIX(weight) ) { ref->weight=MORPHO_GETMATRIX(weight); if (ref->weight) { - ref->mean=matrix_sum(ref->weight); + double sum[ref->weight->nvals]; + matrix_sum(ref->weight, sum); + ref->mean = sum[0]; ref->mean/=ref->weight->ncols; } } @@ -2676,11 +2914,11 @@ FUNCTIONAL_METHOD(EquiElement, gradient, MESH_GRADE_VERTEX, equielementref, equi FUNCTIONAL_METHOD(EquiElement, hessian, MESH_GRADE_VERTEX, equielementref, equielement_prepareref, functional_mapnumericalhessian, equielement_integrand, equielement_dependencies, EQUIELEMENT_ARGS, SYMMETRY_ADD) MORPHO_BEGINCLASS(EquiElement) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, EquiElement_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, EquiElement_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, EquiElement_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, EquiElement_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, EquiElement_hessian, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, EquiElement_init, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, EquiElement_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, EquiElement_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, EquiElement_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, EquiElement_hessian, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ********************************************************************** @@ -2811,12 +3049,12 @@ FUNCTIONAL_METHOD(LineCurvatureSq, gradient, MESH_GRADE_VERTEX, curvatureref, cu FUNCTIONAL_METHOD(LineCurvatureSq, hessian, MESH_GRADE_VERTEX, curvatureref, curvature_prepareref, functional_mapnumericalhessian, linecurvsq_integrand, linecurvsq_dependencies, FUNCTIONAL_ARGS, SYMMETRY_ADD) MORPHO_BEGINCLASS(LineCurvatureSq) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LineCurvatureSq_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, LineCurvatureSq_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRANDFORELEMENT_METHOD, LineCurvatureSq_integrandForElement, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, LineCurvatureSq_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, LineCurvatureSq_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, LineCurvatureSq_hessian, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LineCurvatureSq_init, MORPHO_FN_MUTATES), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, LineCurvatureSq_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_INTEGRANDFORELEMENT_METHOD, LineCurvatureSq_integrandForElement, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, LineCurvatureSq_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, LineCurvatureSq_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, LineCurvatureSq_hessian, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -2917,7 +3155,7 @@ bool linetorsionsq_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int /* We now have an ordered list of vertices. Get the vertex positions */ double *x[6]; - for (int i=0; i<6; i++) matrix_getcolumn(mesh->vert, vlist[i], &x[i]); + for (int i=0; i<6; i++) matrix_getcolumnptr(mesh->vert, vlist[i], &x[i]); double A[3], B[3], C[3], crossAB[3], crossBC[3]; functional_vecsub(3, x[1], x[0], A); @@ -2953,11 +3191,11 @@ FUNCTIONAL_METHOD(LineTorsionSq, gradient, MESH_GRADE_LINE, curvatureref, curvat FUNCTIONAL_METHOD(LineTorsionSq, hessian, MESH_GRADE_LINE, curvatureref, curvature_prepareref, functional_mapnumericalhessian, linetorsionsq_integrand, linetorsionsq_dependencies, FUNCTIONAL_ARGS, SYMMETRY_ADD) MORPHO_BEGINCLASS(LineTorsionSq) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LineTorsionSq_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, LineTorsionSq_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, LineTorsionSq_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, LineTorsionSq_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, LineTorsionSq_hessian, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LineTorsionSq_init, MORPHO_FN_MUTATES), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, LineTorsionSq_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, LineTorsionSq_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, LineTorsionSq_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, LineTorsionSq_hessian, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -3081,7 +3319,7 @@ bool meancurvaturesq_integrand(vm *v, objectmesh *mesh, elementid id, int nv, in double *x[3], s0[3], s1[3], s01[3], s101[3]; double norm; - for (int j=0; j<3; j++) matrix_getcolumn(mesh->vert, vids[j], &x[j]); + for (int j=0; j<3; j++) matrix_getcolumnptr(mesh->vert, vids[j], &x[j]); /* s0 = x1-x0; s1 = x2-x1 */ functional_vecsub(mesh->dim, x[1], x[0], s0); @@ -3115,10 +3353,10 @@ FUNCTIONAL_METHOD(MeanCurvatureSq, total, MESH_GRADE_VERTEX, areacurvatureref, a FUNCTIONAL_METHOD(MeanCurvatureSq, gradient, MESH_GRADE_VERTEX, areacurvatureref, areacurvature_prepareref, functional_mapnumericalgradient, meancurvaturesq_integrand, meancurvaturesq_dependencies, FUNCTIONAL_ARGS, SYMMETRY_ADD) MORPHO_BEGINCLASS(MeanCurvatureSq) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, MeanCurvatureSq_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, MeanCurvatureSq_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, MeanCurvatureSq_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, MeanCurvatureSq_total, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, MeanCurvatureSq_init, MORPHO_FN_MUTATES), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, MeanCurvatureSq_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, MeanCurvatureSq_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, MeanCurvatureSq_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -3155,7 +3393,7 @@ bool gausscurvature_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int if (!curvature_ordervertices(&synid, nvert, vids)) goto gausscurv_cleanup; double *x[3], s0[3], s1[3], s01[3]; - for (int j=0; j<3; j++) matrix_getcolumn(mesh->vert, vids[j], &x[j]); + for (int j=0; j<3; j++) matrix_getcolumnptr(mesh->vert, vids[j], &x[j]); /* s0 = x1-x0; s1 = x2-x0 */ functional_vecsub(mesh->dim, x[1], x[0], s0); @@ -3186,10 +3424,10 @@ FUNCTIONAL_METHOD(GaussCurvature, total, MESH_GRADE_VERTEX, areacurvatureref, ar FUNCTIONAL_METHOD(GaussCurvature, gradient, MESH_GRADE_VERTEX, areacurvatureref, areacurvature_prepareref, functional_mapnumericalgradient, gausscurvature_integrand, meancurvaturesq_dependencies, FUNCTIONAL_ARGS, SYMMETRY_ADD) MORPHO_BEGINCLASS(GaussCurvature) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, GaussCurvature_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, GaussCurvature_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, GaussCurvature_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, GaussCurvature_total, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, GaussCurvature_init, MORPHO_FN_MUTATES), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, GaussCurvature_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, GaussCurvature_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, GaussCurvature_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ********************************************************************** @@ -3201,6 +3439,45 @@ typedef struct { grade grade; } fieldref; +static bool functional_preparefespacefield(objectfield *field, grade g) { + if (!field || !MORPHO_ISFESPACE(field->fnspc)) return true; + + fespace *disc = MORPHO_GETFESPACE(field->fnspc)->fespace; + if (ggrade) { + if (!fespace_lower(disc, g, &disc)) return false; + } + + objectsparse *conn = mesh_getconnectivityelement(field->mesh, 0, disc->grade); + if (!conn) conn = mesh_addconnectivityelement(field->mesh, 0, disc->grade); + if (!conn) return false; + + for (grade i=0; i<=disc->grade; i++) { + objectsparse *vmatrix = mesh_addconnectivityelement(field->mesh, i, 0); + if (!vmatrix && i>0 && disc->shape[i]>0) { + if (!mesh_addgrade(field->mesh, i)) return false; + vmatrix = mesh_addconnectivityelement(field->mesh, i, 0); + } + if (!vmatrix && i>0 && disc->shape[i]>0) return false; + } + + return true; +} + +static bool functional_preparefieldlist(value *fields, int nfields, grade g) { + for (int i=0; iref; + return functional_preparefespacefield(ref->field, info->g); +} + /* ---------------------------------------------- * GradSq * ---------------------------------------------- */ @@ -3328,18 +3605,16 @@ bool gradsq_evaluategradient3d(objectmesh *mesh, objectfield *field, int nv, int objectmatrix Mt = MORPHO_STATICMATRIX(xtarray, mesh->dim, mesh->dim); matrix_transpose(&M, &Mt); - double farray[nentries*mesh->dim]; // Field elements - objectmatrix frhs = MORPHO_STATICMATRIX(farray, mesh->dim, nentries); objectmatrix grad = MORPHO_STATICMATRIX(out, mesh->dim, nentries); // Loop over elements of the field for (unsigned int i=0; idim; j++) farray[i*mesh->dim+j] = f[j+1][i]-f[0][i]; + for (unsigned int j=0; jdim; j++) out[i*mesh->dim+j] = f[j+1][i]-f[0][i]; } // Solve to obtain the gradient of each element - matrix_divs(&Mt, &frhs, &grad); + matrix_solvesmall(&Mt, &grad); return true; } @@ -3421,11 +3696,11 @@ value GradSq_init(vm *v, int nargs, value *args) { return MORPHO_NIL; } -FUNCTIONAL_METHOD(GradSq, integrand, (ref.grade), fieldref, gradsq_prepareref, functional_mapintegrand, gradsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(GradSq, integrand, (ref.grade), fieldref, gradsq_prepareref, fieldref_startfn, functional_mapintegrand, gradsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(GradSq, total, (ref.grade), fieldref, gradsq_prepareref, functional_sumintegrand, gradsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(GradSq, total, (ref.grade), fieldref, gradsq_prepareref, fieldref_startfn, functional_sumintegrand, gradsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(GradSq, gradient, (ref.grade), fieldref, gradsq_prepareref, functional_mapnumericalgradient, gradsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_ADD); +FUNCTIONAL_METHOD_START(GradSq, gradient, (ref.grade), fieldref, gradsq_prepareref, fieldref_startfn, functional_mapnumericalgradient, gradsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_ADD); value GradSq_fieldgradient(vm *v, int nargs, value *args) { functional_mapinfo info; @@ -3437,9 +3712,10 @@ value GradSq_fieldgradient(vm *v, int nargs, value *args) { info.g = ref.grade; info.field = ref.field; info.integrand = gradsq_integrand; + info.start = fieldref_startfn; info.cloneref = gradsq_cloneref; info.ref = &ref; - functional_mapnumericalfieldgradient(v, &info, &out); + if (functional_startmap(v, &info)) functional_mapnumericalfieldgradient(v, &info, &out); //functional_mapfieldgradient(v, &info, &out); } else morpho_runtimeerror(v, GRADSQ_ARGS); } @@ -3448,11 +3724,11 @@ value GradSq_fieldgradient(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(GradSq) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, GradSq_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, GradSq_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, GradSq_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, GradSq_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, GradSq_fieldgradient, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, GradSq_init, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, GradSq_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, GradSq_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, GradSq_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, GradSq_fieldgradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -3471,6 +3747,12 @@ typedef struct { grade grade; } nematicref; +static bool nematic_startfn(vm *v, functional_mapinfo *info) { + (void) v; + nematicref *ref = (nematicref *) info->ref; + return functional_preparefespacefield(ref->field, info->g); +} + /** Prepares the nematic reference */ bool nematic_prepareref(objectinstance *self, objectmesh *mesh, grade g, objectselection *sel, nematicref *ref) { bool success=false, grdset=false; @@ -3668,11 +3950,11 @@ value Nematic_init(vm *v, int nargs, value *args) { return MORPHO_NIL; } -FUNCTIONAL_METHOD(Nematic, integrand, (ref.grade), nematicref, nematic_prepareref, functional_mapintegrand, nematic_integrand, NULL, NEMATIC_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(Nematic, integrand, (ref.grade), nematicref, nematic_prepareref, nematic_startfn, functional_mapintegrand, nematic_integrand, NULL, NEMATIC_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(Nematic, total, (ref.grade), nematicref, nematic_prepareref, functional_sumintegrand, nematic_integrand, NULL, NEMATIC_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(Nematic, total, (ref.grade), nematicref, nematic_prepareref, nematic_startfn, functional_sumintegrand, nematic_integrand, NULL, NEMATIC_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(Nematic, gradient, (ref.grade), nematicref, nematic_prepareref, functional_mapnumericalgradient, nematic_integrand, NULL, NEMATIC_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(Nematic, gradient, (ref.grade), nematicref, nematic_prepareref, nematic_startfn, functional_mapnumericalgradient, nematic_integrand, NULL, NEMATIC_ARGS, SYMMETRY_NONE); value Nematic_fieldgradient(vm *v, int nargs, value *args) { functional_mapinfo info; @@ -3683,9 +3965,10 @@ value Nematic_fieldgradient(vm *v, int nargs, value *args) { if (nematic_prepareref(MORPHO_GETINSTANCE(MORPHO_SELF(args)), info.mesh, MESH_GRADE_AREA, info.sel, &ref)) { info.g=ref.grade; info.integrand=nematic_integrand; + info.start=nematic_startfn; info.ref=&ref; info.cloneref=nematic_cloneref; - functional_mapnumericalfieldgradient(v, &info, &out); + if (functional_startmap(v, &info)) functional_mapnumericalfieldgradient(v, &info, &out); } else morpho_runtimeerror(v, GRADSQ_ARGS); } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); @@ -3693,11 +3976,11 @@ value Nematic_fieldgradient(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Nematic) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Nematic_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, Nematic_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, Nematic_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, Nematic_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, Nematic_fieldgradient, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Nematic_init, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, Nematic_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, Nematic_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, Nematic_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, Nematic_fieldgradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -3710,6 +3993,17 @@ typedef struct { grade grade; } nematicelectricref; +static bool nematicelectric_startfn(vm *v, functional_mapinfo *info) { + (void) v; + nematicelectricref *ref = (nematicelectricref *) info->ref; + + if (!functional_preparefespacefield(ref->director, info->g)) return false; + if (MORPHO_ISFIELD(ref->field) && + !functional_preparefespacefield(MORPHO_GETFIELD(ref->field), info->g)) return false; + + return true; +} + /** Prepares the nematicelectric reference */ bool nematicelectric_prepareref(objectinstance *self, objectmesh *mesh, grade g, objectselection *sel, nematicelectricref *ref) { bool success=false, grdset=false; @@ -3814,11 +4108,11 @@ value NematicElectric_init(vm *v, int nargs, value *args) { return MORPHO_NIL; } -FUNCTIONAL_METHOD(NematicElectric, integrand, (ref.grade), nematicelectricref, nematicelectric_prepareref, functional_mapintegrand, nematicelectric_integrand, NULL, FUNCTIONAL_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(NematicElectric, integrand, (ref.grade), nematicelectricref, nematicelectric_prepareref, nematicelectric_startfn, functional_mapintegrand, nematicelectric_integrand, NULL, FUNCTIONAL_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(NematicElectric, total, (ref.grade), nematicelectricref, nematicelectric_prepareref, functional_sumintegrand, nematicelectric_integrand, NULL, FUNCTIONAL_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(NematicElectric, total, (ref.grade), nematicelectricref, nematicelectric_prepareref, nematicelectric_startfn, functional_sumintegrand, nematicelectric_integrand, NULL, FUNCTIONAL_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(NematicElectric, gradient, (ref.grade), nematicelectricref, nematicelectric_prepareref, functional_mapnumericalgradient, nematicelectric_integrand, NULL, FUNCTIONAL_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(NematicElectric, gradient, (ref.grade), nematicelectricref, nematicelectric_prepareref, nematicelectric_startfn, functional_mapnumericalgradient, nematicelectric_integrand, NULL, FUNCTIONAL_ARGS, SYMMETRY_NONE); value NematicElectric_fieldgradient(vm *v, int nargs, value *args) { functional_mapinfo info; @@ -3829,9 +4123,10 @@ value NematicElectric_fieldgradient(vm *v, int nargs, value *args) { if (nematicelectric_prepareref(MORPHO_GETINSTANCE(MORPHO_SELF(args)), info.mesh, MESH_GRADE_AREA, info.sel, &ref)) { info.g=ref.grade; info.integrand=nematicelectric_integrand; + info.start=nematicelectric_startfn; info.cloneref=nematicelectric_cloneref; info.ref=&ref; - functional_mapnumericalfieldgradient(v, &info, &out); + if (functional_startmap(v, &info)) functional_mapnumericalfieldgradient(v, &info, &out); } else morpho_runtimeerror(v, GRADSQ_ARGS); } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); @@ -3839,11 +4134,11 @@ value NematicElectric_fieldgradient(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(NematicElectric) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, NematicElectric_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, NematicElectric_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, NematicElectric_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, NematicElectric_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, NematicElectric_fieldgradient, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, NematicElectric_init, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, NematicElectric_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, NematicElectric_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, NematicElectric_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, NematicElectric_fieldgradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -3864,11 +4159,11 @@ bool normsq_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, v return false; } -FUNCTIONAL_METHOD(NormSq, integrand, MESH_GRADE_VERTEX, fieldref, gradsq_prepareref, functional_mapintegrand, normsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(NormSq, integrand, MESH_GRADE_VERTEX, fieldref, gradsq_prepareref, fieldref_startfn, functional_mapintegrand, normsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(NormSq, total, MESH_GRADE_VERTEX, fieldref, gradsq_prepareref, functional_sumintegrand, normsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(NormSq, total, MESH_GRADE_VERTEX, fieldref, gradsq_prepareref, fieldref_startfn, functional_sumintegrand, normsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(NormSq, gradient, MESH_GRADE_VERTEX, fieldref, gradsq_prepareref, functional_mapnumericalgradient, normsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(NormSq, gradient, MESH_GRADE_VERTEX, fieldref, gradsq_prepareref, fieldref_startfn, functional_mapnumericalgradient, normsq_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); value NormSq_fieldgradient(vm *v, int nargs, value *args) { functional_mapinfo info; @@ -3881,8 +4176,9 @@ value NormSq_fieldgradient(vm *v, int nargs, value *args) { info.ref=&ref; info.field=ref.field; info.integrand=normsq_integrand; + info.start=fieldref_startfn; info.cloneref=gradsq_cloneref; - functional_mapnumericalfieldgradient(v, &info, &out); + if (functional_startmap(v, &info)) functional_mapnumericalfieldgradient(v, &info, &out); } else morpho_runtimeerror(v, GRADSQ_ARGS); } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); @@ -3890,11 +4186,11 @@ value NormSq_fieldgradient(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(NormSq) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, GradSq_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, NormSq_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, NormSq_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, NormSq_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, NormSq_fieldgradient, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, GradSq_init, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, NormSq_integrand, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, NormSq_total, MORPHO_FN_PUREFN|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, NormSq_gradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, NormSq_fieldgradient, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ********************************************************************** @@ -3917,6 +4213,25 @@ typedef struct { bool weightbyref; // Use reference mesh for the element } integralref; +static bool integral_startfn(vm *v, functional_mapinfo *info) { + (void) v; + integralref *ref = (integralref *) info->ref; + return functional_preparefieldlist(ref->fields, ref->nfields, info->g); +} + +typedef struct jumpref_s jumpref; + +typedef enum { + JUMP_STRATEGY_CENTROID_MODE, + JUMP_STRATEGY_QUADRATURE_MODE +} jumpstrategy; + +typedef struct { + int nv; + int *vid; + quantity *quantities; +} jumpside; + /* ---------------------------------------------- * Integrand functions * ---------------------------------------------- */ @@ -3947,6 +4262,7 @@ typedef struct { objectmatrix *invj; // Inverse jacobian for the element value *qgrad; // Gradients + value *qhess; // Hessians value *qinterpolated; // List of interpolated quantities (this allows us to identify operators on fields } objectintegralelementref; @@ -3990,6 +4306,92 @@ objectintegralelementref *integral_getelementref(vm *v) { return NULL; } +/* ---------------------------------------------- + * Jump interface references + * ---------------------------------------------- */ + +/** Thread-local interface context for Jump functionals. */ +typedef struct { + object obj; + objectmesh *mesh; // The current mesh object + vm *v; // Worker VM for callbacks on this interface + + jumpref *jref; // Shared Jump reference + + grade g; // Interface grade + elementid id; // Interface id + int nv; // Number of interface vertices + int *vid; // Interface vertex ids + double **vertexposn; // Interface vertex positions + double interfacesize; // Size/measure of the interface + + elementid plusid; // Canonical + parent element id + elementid minusid; // Canonical - parent element id + + int plusnv, minusnv; // Number of vertices in parent elements + int *plusvid, *minusvid; // Vertex ids in parent elements + + jumpside qplus; + jumpside qminus; + + objectmatrix *normal; // Canonical interface normal + + double *pluslambda; // Parent-element barycentric coordinates on + side + double *minuslambda; // Parent-element barycentric coordinates on - side + double *posn; // Current physical position + value *qinterpolated; // Current interpolated quantities passed to the integrand + + value *qplusgrad; // Per-side cached gradients, later + value *qminusgrad; + value *qplushess; // Per-side cached Hessians, later + value *qminushess; +} objectjumpinterfaceref; + +size_t objectjumpinterfaceref_sizefn(object *obj) { + return sizeof(objectjumpinterfaceref); +} + +void objectjumpinterfaceref_printfn(object *obj, void *v) { + morpho_printf(v, ""); +} + +objecttypedefn objectjumpinterfacerefdefn = { + .printfn=objectjumpinterfaceref_printfn, + .markfn=NULL, + .freefn=NULL, + .sizefn=objectjumpinterfaceref_sizefn, + .hashfn=NULL, + .cmpfn=NULL +}; + +objecttype objectjumpinterfacereftype; +#define OBJECT_JUMPINTERFACEREF objectjumpinterfacereftype + +#define MORPHO_ISJUMPINTERFACEREF(val) object_istype(val, OBJECT_JUMPINTERFACEREF) +#define MORPHO_GETJUMPINTERFACEREF(val) ((objectjumpinterfaceref *) MORPHO_GETOBJECT(val)) +#define MORPHO_STATICJUMPINTERFACEREF(mesh, grade, id, nv, vid) { .obj.type=OBJECT_JUMPINTERFACEREF, .obj.status=OBJECT_ISUNMANAGED, .obj.next=NULL, .mesh=mesh, .v=NULL, .g=grade, .id=id, .nv=nv, .vid=vid, .qplus={0}, .qminus={0}, .normal=NULL, .pluslambda=NULL, .minuslambda=NULL, .posn=NULL, .qinterpolated=NULL, .qplusgrad=NULL, .qminusgrad=NULL, .qplushess=NULL, .qminushess=NULL } + +int jumpinterfacehandle; + +static objectjumpinterfaceref *jump_getinterfaceref(vm *v) { + value iref=MORPHO_NIL; + vm_gettlvar(v, jumpinterfacehandle, &iref); + if (MORPHO_ISJUMPINTERFACEREF(iref)) return MORPHO_GETJUMPINTERFACEREF(iref); + + return NULL; +} + +/* --------- + * Elementid + * --------- */ + +static value integral_elementid(vm *v, int nargs, value *args) { + objectintegralelementref *elref = integral_getelementref(v); + if (!elref) { morpho_runtimeerror(v, INTEGRAL_SPCLFN, ELEMENTID_FUNCTION); return MORPHO_NIL; } + + return MORPHO_INTEGER(elref->id); +} + /* -------- * Tangent * -------- */ @@ -4000,10 +4402,14 @@ int tangenthandle; // TL storage handle for tangent vectors void integral_evaluatetangent(vm *v, value *out) { objectintegralelementref *elref = integral_getelementref(v); if (!elref) { morpho_runtimeerror(v, INTEGRAL_SPCLFN, TANGENT_FUNCTION); return; } + if (elref->g!=1) { + morpho_runtimeerror(v, TNGNT_GRD); + return; + } int dim = elref->mesh->dim; - objectmatrix *mtangent = object_newmatrix(dim, 1, false); + objectmatrix *mtangent = matrix_new(dim, 1, false); if (!mtangent) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return; @@ -4036,11 +4442,17 @@ int normlhandle; // TL storage handle for normal vectors /** Evaluates the normal vector */ void integral_evaluatenormal(vm *v, value *out) { objectintegralelementref *elref = integral_getelementref(v); + if (!elref) { morpho_runtimeerror(v, INTEGRAL_SPCLFN, NORMAL_FUNCTION); return; } + if (elref->g!=2) { + morpho_runtimeerror(v, NRML_GRD); + return; + } int dim = elref->mesh->dim; double s0[dim], s1[dim]; - objectmatrix *mnormal = object_newmatrix(dim, 1, false); + + objectmatrix *mnormal = matrix_new(dim, 1, false); if (!mnormal) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return; @@ -4086,7 +4498,8 @@ bool integral_prepareinvjacobian(unsigned int dim, grade g, double **x, objectma if (g==dim) { objectmatrix smat = MORPHO_STATICMATRIX(s, dim, dim); - success=(matrix_inverse(&smat, invj)==MATRIX_OK); + success=(matrix_copy(&smat, invj)==LINALGERR_OK && + matrix_inverse(invj)==LINALGERR_OK); } else if (g==1) { double s01norm = functional_vecdot(dim, s, s); if (s01norm>0) { @@ -4117,7 +4530,7 @@ bool integral_prepareinvjacobian(unsigned int dim, grade g, double **x, objectma /** Allocate suitable storage for the gradient */ bool integral_gradalloc(int dim, value prototype, value *out) { if (MORPHO_ISNIL(prototype)) { // Scalar - objectmatrix *mgrad=object_newmatrix(dim, 1, false); + objectmatrix *mgrad=matrix_new(dim, 1, false); if (mgrad) *out = MORPHO_OBJECT(mgrad); return mgrad; } else if (MORPHO_ISMATRIX(prototype)) { @@ -4128,6 +4541,20 @@ bool integral_gradalloc(int dim, value prototype, value *out) { return false; } +/** Allocate suitable storage for the hessian */ +bool integral_hessalloc(int dim, value prototype, value *out) { + if (MORPHO_ISNIL(prototype)) { // Scalar + objectmatrix *mhess=matrix_new(dim, dim, false); + if (mhess) *out = MORPHO_OBJECT(mhess); + return mhess; + } else if (MORPHO_ISMATRIX(prototype)) { + objectlist *mlst = object_newlist(0, NULL); + if (mlst) *out = MORPHO_OBJECT(mlst); + return mlst; + } else UNREACHABLE("Field type not supported in hess"); + return false; +} + /** Prepares the gradient sum to hold the component of the gradient */ bool integral_gradsuminit(int i, value prototype, value dest, value *sum) { if (MORPHO_ISLIST(dest)) { @@ -4135,7 +4562,7 @@ bool integral_gradsuminit(int i, value prototype, value dest, value *sum) { if (i>=list_length(lst)) { objectmatrix *prmat = MORPHO_GETMATRIX(prototype); - objectmatrix *new = object_newmatrix(prmat->nrows, prmat->ncols, true); + objectmatrix *new = matrix_new(prmat->nrows, prmat->ncols, true); if (!new) return false; *sum = MORPHO_OBJECT(new); list_append(lst, *sum); @@ -4154,6 +4581,32 @@ bool integral_gradsumcopy(int i, value sum, value dest) { } else return true; } +/** Prepares the hessian sum to hold a component of the hessian */ +bool integral_hesssuminit(int c, value prototype, value dest, value *sum) { + if (MORPHO_ISLIST(dest)) { + objectlist *lst = MORPHO_GETLIST(dest); + + if (c>=list_length(lst)) { + objectmatrix *prmat = MORPHO_GETMATRIX(prototype); + objectmatrix *new = matrix_new(prmat->nrows, prmat->ncols, true); + if (!new) return false; + *sum = MORPHO_OBJECT(new); + list_append(lst, *sum); + } else { + matrix_zero(MORPHO_GETMATRIX(lst->val.data[c])); + *sum = lst->val.data[c]; + } + } + return true; +} + +/** Copies the component of the hessian into the relevant destination if needed */ +bool integral_hesssumcopy(int i, int j, value sum, value dest) { + if (MORPHO_ISMATRIX(dest)) { + return morpho_valuetofloat(sum, &MORPHO_GETMATRIX(dest)->elements[j*MORPHO_GETMATRIX(dest)->nrows+i]); + } else return true; +} + /** Copies the component of the gradient into the relevant destination */ bool integral_oldgradcopy(int dim, int ndof, double *grad, value prototype, value dest) { bool success=false; @@ -4169,7 +4622,7 @@ bool integral_oldgradcopy(int dim, int ndof, double *grad, value prototype, valu value el; if (i>=list_length(lst)) { - mgrad=object_newmatrix(proto->nrows, proto->ncols, false); // Should copy prototype dimensions! + mgrad=matrix_new(proto->nrows, proto->ncols, false); // Should copy prototype dimensions! if (mgrad) { for (int k=0; kelements[k]=grad[k*dim+i]; list_append(lst, MORPHO_OBJECT(mgrad)); @@ -4219,7 +4672,7 @@ bool integral_evaluategradient(vm *v, value q, value *out) { // Evaluate gradient if (MORPHO_ISFESPACE(fld->fnspc)) { if (!elref->invj) { - elref->invj=object_newmatrix(elref->g, elref->mesh->dim, false); + elref->invj=matrix_new(elref->g, elref->mesh->dim, false); if (elref->invj) { integral_prepareinvjacobian(elref->mesh->dim, elref->g, elref->vertexposn, elref->invj); @@ -4229,19 +4682,24 @@ bool integral_evaluategradient(vm *v, value q, value *out) { } } - int nnodes = MORPHO_GETFESPACE(fld->fnspc)->fespace->nnodes; + fespace *disc = MORPHO_GETFESPACE(fld->fnspc)->fespace; + if (!FESPACE_HASGRADIENT(disc)) { + morpho_runtimeerror(v, INTEGRAL_GRDEVL); + return false; + } + + int nnodes = disc->nnodes; double gdata[nnodes * elref->g]; objectmatrix gmat = MORPHO_STATICMATRIX(gdata, nnodes, elref->g); // Compute gradient in reference frame - fespace_gradient(MORPHO_GETFESPACE(fld->fnspc)->fespace, - elref->lambda, &gmat); + fespace_gradient(disc, elref->lambda, &gmat); // Compute matrix double fmatdata[nnodes * dim]; objectmatrix fmat = MORPHO_STATICMATRIX(fmatdata, nnodes, dim); - if (matrix_mul(&gmat, elref->invj, &fmat)!=MATRIX_OK) { + if (matrix_mul(&gmat, elref->invj, &fmat)!=LINALGERR_OK) { morpho_runtimeerror(v, INTEGRAL_GRDEVL); return false; } @@ -4286,47 +4744,148 @@ static value integral_gradfn(vm *v, int nargs, value *args) { return out; } -/* ------------------- - * Cauchy green strain - * ------------------- */ - -int cauchygreenhandle; // TL storage handle for CG tensor - -/** Evaluates the cg strain tensor */ -void integral_evaluatecg(vm *v, value *out) { +/** Evaluates the hessian of a field */ +bool integral_evaluatehessian(vm *v, value q, value *out) { objectintegralelementref *elref = integral_getelementref(v); + if (!elref) { morpho_runtimeerror(v, INTEGRAL_SPCLFN, HESS_FUNCTION); return false; } - if (!elref || !elref->iref->mref) { - morpho_runtimeerror(v, INTEGRAL_SPCLFN, CGTENSOR_FUNCTION); return; + int ifld, xfld=-1; + for (ifld=0; ifldiref->nfields; ifld++) { + if (MORPHO_ISFIELD(q) && MORPHO_ISSAME(elref->iref->originalfields[ifld], q)) break; + else if (MORPHO_ISSAME(elref->qinterpolated[ifld], q)) { + if (xfld>=0) { morpho_runtimeerror(v, INTEGRAL_AMBGSFLD); return false; } + xfld=ifld; + } } + if (xfld>=0) ifld = xfld; - int gdim=elref->nv-1; // Dimension of Gram matrix - - objectmatrix *cg=object_newmatrix(gdim, gdim, true); - if (!cg) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return; } - - double gramrefel[gdim*gdim], gramdefel[gdim*gdim], qel[gdim*gdim], rel[gdim*gdim]; - objectmatrix gramref = MORPHO_STATICMATRIX(gramrefel, gdim, gdim); // Gram matrices - objectmatrix gramdef = MORPHO_STATICMATRIX(gramdefel, gdim, gdim); // - objectmatrix q = MORPHO_STATICMATRIX(qel, gdim, gdim); // Inverse of Gram in source domain - objectmatrix r = MORPHO_STATICMATRIX(rel, gdim, gdim); // Intermediate calculations + if (ifld>=elref->iref->nfields) { + morpho_runtimeerror(v, INTEGRAL_FLD); return false; + } - linearelasticity_calculategram(elref->iref->mref->vert, elref->mesh->dim, elref->nv, elref->vid, &gramref); - linearelasticity_calculategram(elref->mesh->vert, elref->mesh->dim, elref->nv, elref->vid, &gramdef); + objectfield *fld = MORPHO_GETFIELD(elref->iref->fields[ifld]); + int dim = elref->mesh->dim; - if (matrix_inverse(&gramref, &q)!=MATRIX_OK) return; - if (matrix_mul(&gramdef, &q, &r)!=MATRIX_OK) return; - - matrix_identity(cg); - matrix_scale(cg, -0.5); - matrix_accumulate(cg, 0.5, &r); + if (!MORPHO_ISOBJECT(elref->qhess[ifld])) { + if (!integral_hessalloc(dim, fld->prototype, &elref->qhess[ifld])) { + morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return false; + } + } - vm_settlvar(v, cauchygreenhandle, MORPHO_OBJECT(cg)); - *out = MORPHO_OBJECT(cg); -} - -static value integral_cgfn(vm *v, int nargs, value *args) { - value out=MORPHO_NIL; + if (MORPHO_ISFESPACE(fld->fnspc)) { + if (!elref->invj) { + elref->invj=matrix_new(elref->g, elref->mesh->dim, false); + if (elref->invj) { + integral_prepareinvjacobian(elref->mesh->dim, elref->g, elref->vertexposn, elref->invj); + } else { + morpho_runtimeerror(v, INTEGRAL_HSSEVL); + return false; + } + } + + fespace *disc = MORPHO_GETFESPACE(fld->fnspc)->fespace; + if (!FESPACE_HASHESSIAN(disc)) { + morpho_runtimeerror(v, INTEGRAL_HSSEVL); + return false; + } + int nnodes = disc->nnodes; + double hdata[nnodes * elref->g * elref->g]; + objectmatrix hmat = MORPHO_STATICMATRIX(hdata, nnodes, elref->g*elref->g); + + fespace_hessian(disc, elref->lambda, &hmat); + + double fdata[nnodes * dim * dim]; + for (int j=0; jg; qref++) { + for (int pref=0; prefg; pref++) { + sum += hdata[(qref*elref->g+pref)*nnodes+n] * + elref->invj->elements[i*elref->g+pref] * + elref->invj->elements[j*elref->g+qref]; + } + } + outcol[n]=sum; + } + } + } + + for (int j=0; jprototype, elref->qhess[ifld], &sum) && + integrator_sumquantityweighted(nnodes, fdata+c*nnodes, elref->quantities[ifld].vals, &sum)) { + integral_hesssumcopy(i, j, sum, elref->qhess[ifld]); + } else { + morpho_runtimeerror(v, INTEGRAL_HSSEVL); + return false; + } + } + } + + *out=elref->qhess[ifld]; + return true; + } + + morpho_runtimeerror(v, INTEGRAL_HSSEVL); + return false; +} + +static value integral_hessfn(vm *v, int nargs, value *args) { + value out=MORPHO_NIL; + if (nargs==1) { + integral_evaluatehessian(v, MORPHO_GETARG(args, 0), &out); + } else morpho_runtimeerror(v, INTEGRAL_FLD); + + return out; +} + +/* ------------------- + * Cauchy green strain + * ------------------- */ + +int cauchygreenhandle; // TL storage handle for CG tensor + +/** Evaluates the cg strain tensor */ +void integral_evaluatecg(vm *v, value *out) { + objectintegralelementref *elref = integral_getelementref(v); + + if (!elref || !elref->iref->mref) { + morpho_runtimeerror(v, INTEGRAL_SPCLFN, CGTENSOR_FUNCTION); return; + } + + int gdim=elref->nv-1; // Dimension of Gram matrix + + objectmatrix *cg=matrix_new(gdim, gdim, true); + if (!cg) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return; } + + double gramrefel[gdim*gdim], gramdefel[gdim*gdim], qel[gdim*gdim], rel[gdim*gdim]; + objectmatrix gramref = MORPHO_STATICMATRIX(gramrefel, gdim, gdim); // Gram matrices + objectmatrix gramdef = MORPHO_STATICMATRIX(gramdefel, gdim, gdim); // + objectmatrix q = MORPHO_STATICMATRIX(qel, gdim, gdim); // Inverse of Gram in source domain + objectmatrix r = MORPHO_STATICMATRIX(rel, gdim, gdim); // Intermediate calculations + + linearelasticity_calculategram(elref->iref->mref->vert, elref->mesh->dim, elref->nv, elref->vid, &gramref); + linearelasticity_calculategram(elref->mesh->vert, elref->mesh->dim, elref->nv, elref->vid, &gramdef); + + if (matrix_copy(&gramref, &q)!=LINALGERR_OK) return; + if (matrix_inverse(&q)!=LINALGERR_OK) return; + if (matrix_mul(&gramdef, &q, &r)!=LINALGERR_OK) return; + + if (matrix_identity(cg)!=LINALGERR_OK) return; + matrix_scale(cg, -0.5); + matrix_axpy(0.5, &r, cg); + + vm_settlvar(v, cauchygreenhandle, MORPHO_OBJECT(cg)); + *out = MORPHO_OBJECT(cg); +} + +static value integral_cgfn(vm *v, int nargs, value *args) { + value out=MORPHO_NIL; vm_gettlvar(v, cauchygreenhandle, &out); if (MORPHO_ISNIL(out)) integral_evaluatecg(v, &out); @@ -4334,13 +4893,104 @@ static value integral_cgfn(vm *v, int nargs, value *args) { return out; } +/* ------------------- + * Jacobian + * ------------------- */ + +/* + * A reference triangle is mapped to a target triangle through a + * linear transformation (the pushforward); an inverse transformation (the pullback) + * exists if the triangle is not degenerate. This function computes the forward + * and inverse jacobians. + */ + +int jacobianhandle; // TL storage handle for Jacobian +int invjacobianhandle; // TL storage handle for inverse Jacobian + +void _fetchvertices(objectintegralelementref *elref, objectmesh *mesh, int nv, elementid *vid, double **x) { + // Fetch reference vertices + for (int j=0; jiref->mref->vert, vid[j], &x[j]); +} + +void _edgevectors(grade g, int dim, double **x, double *out) { + for (int i=0; imesh->dim; // Dimension of the mesh + + // Allocate matrices + objectmatrix *J=matrix_new(dim, dim, true); + objectmatrix *Jinv=matrix_new(dim, dim, true); + + if (J) vm_settlvar(v, jacobianhandle, MORPHO_OBJECT(J)); + if (Jinv) vm_settlvar(v, invjacobianhandle, MORPHO_OBJECT(Jinv)); + + if (!J || !Jinv) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return; } + + // Now compute them + grade g = elref->g; // Grade of the element + int nv = elref->nv; // + + double **X = elref->vertexposn; // Vertex positions of the target element + double *x[nv]; // Vertex positions of the reference element + + objectmesh *mref = elref->iref->mref; // Reference mesh + if (mref) _fetchvertices(elref, mref, nv, elref->vid, x); + + // Construct matrix of edge vectors for target and reference elements + double starget[dim*dim], sinv[dim*dim]; + objectmatrix St = MORPHO_STATICMATRIX(starget, dim, dim), + Sinv = MORPHO_STATICMATRIX(sinv, dim, dim); + + _edgevectors(g, dim, X, starget); + if (mref) { + _edgevectors(g, dim, x, sinv); + matrix_inverse(&Sinv); + } else { + matrix_identity(&Sinv); // If no reference, the reference is the unit triangle + } + + matrix_mul(&St, &Sinv, J); // J = S . s^-1 + matrix_copy(J, Jinv); + matrix_inverse(Jinv); // Compute J^-1 + + if (jac) *jac = MORPHO_OBJECT(J); + if (invjac) *invjac = MORPHO_OBJECT(Jinv); +} + +static value integral_jacobian(vm *v, int nargs, value *args) { + value out=MORPHO_NIL; + + vm_gettlvar(v, jacobianhandle, &out); + if (MORPHO_ISNIL(out)) integral_evaluatejacobian(v, &out, NULL); + + return out; +} + +static value integral_invjacobian(vm *v, int nargs, value *args) { + value out=MORPHO_NIL; + + vm_gettlvar(v, invjacobianhandle, &out); + if (MORPHO_ISNIL(out)) integral_evaluatejacobian(v, NULL, &out); + + return out; +} + /* ---------------------- * General initialization * ---------------------- */ /** Clears threadlocal storage */ void integral_cleartlvars(vm *v) { - int handles[] = { elementhandle, normlhandle, tangenthandle, cauchygreenhandle, -1 }; + int handles[] = { elementhandle, normlhandle, tangenthandle, cauchygreenhandle, jacobianhandle, invjacobianhandle, -1 }; for (int i=0; handles[i]>=0; i++) { vm_settlvar(v, handles[i], MORPHO_NIL); @@ -4348,7 +4998,7 @@ void integral_cleartlvars(vm *v) { } void integral_freetlvars(vm *v) { - int handles[] = { normlhandle, tangenthandle, cauchygreenhandle, -1 }; + int handles[] = { normlhandle, tangenthandle, cauchygreenhandle,jacobianhandle, invjacobianhandle, -1 }; for (int i=0; handles[i]>=0; i++) { value val; @@ -4448,9 +5098,10 @@ void integral_clearelref(objectintegralelementref *elref) { /** Prepares quantity list */ bool integral_preparequantities(integralref *iref, int nv, int *vid, quantity *quantities) { - bool success=false; + bool success=true; for (int k=0; knfields; k++) { objectfield *f=MORPHO_GETFIELD(iref->fields[k]); + quantities[k].vals=NULL; if (MORPHO_ISFESPACE(f->fnspc)) { fespace *disc=MORPHO_GETFESPACE(f->fnspc)->fespace; @@ -4462,21 +5113,23 @@ bool integral_preparequantities(integralref *iref, int nv, int *vid, quantity *q quantities[k].ifn=disc->ifn; fieldindx findx[disc->nnodes]; - fespace_doftofieldindx(f, disc, nv, vid, findx); + if (!fespace_doftofieldindx(f, disc, nv, vid, findx)) return false; quantities[k].vals=MORPHO_MALLOC(sizeof(value)*disc->nnodes); + if (!quantities[k].vals) return false; for (int i=0; innodes; i++) { int dof; - field_getindex(f, findx[i].g, findx[i].id, findx[i].indx, &dof); - field_getelementwithindex(f, dof, &quantities[k].vals[i]); + if (!field_getindex(f, findx[i].g, findx[i].id, findx[i].indx, &dof)) return false; + if (!field_getelementwithindex(f, dof, &quantities[k].vals[i])) return false; } success=true; } else { quantities[k].nnodes=nv; quantities[k].ifn=NULL; quantities[k].vals=MORPHO_MALLOC(sizeof(value)*nv); + if (!quantities[k].vals) return false; for (unsigned int i=0; idim, MESH_GRADE_LINE, x, iref.nfields, quantities, &iref, out, &err); @@ -4577,18 +5234,23 @@ bool lineintegral_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int * for (int j=0; jval.count; j++) morpho_freeobject(l->val.data[j]); } morpho_freeobject(qgrad[i]); + if (MORPHO_ISLIST(qhess[i])) { + objectlist *l = MORPHO_GETLIST(qhess[i]); + for (int j=0; jval.count; j++) morpho_freeobject(l->val.data[j]); + } + morpho_freeobject(qhess[i]); } return success; } -FUNCTIONAL_METHOD(LineIntegral, integrand, MESH_GRADE_LINE, integralref, integral_prepareref, functional_mapintegrand, lineintegral_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(LineIntegral, integrand, MESH_GRADE_LINE, integralref, integral_prepareref, integral_startfn, functional_mapintegrand, lineintegral_integrand, NULL, LINEINTEGRAL_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(LineIntegral, total, MESH_GRADE_LINE, integralref, integral_prepareref, functional_sumintegrand, lineintegral_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(LineIntegral, total, MESH_GRADE_LINE, integralref, integral_prepareref, integral_startfn, functional_sumintegrand, lineintegral_integrand, NULL, LINEINTEGRAL_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(LineIntegral, gradient, MESH_GRADE_LINE, integralref, integral_prepareref, functional_mapnumericalgradient, lineintegral_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(LineIntegral, gradient, MESH_GRADE_LINE, integralref, integral_prepareref, integral_startfn, functional_mapnumericalgradient, lineintegral_integrand, NULL, LINEINTEGRAL_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(LineIntegral, hessian, MESH_GRADE_LINE, integralref, integral_prepareref, functional_mapnumericalhessian, lineintegral_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE) +FUNCTIONAL_METHOD_START(LineIntegral, hessian, MESH_GRADE_LINE, integralref, integral_prepareref, integral_startfn, functional_mapnumericalhessian, lineintegral_integrand, NULL, LINEINTEGRAL_ARGS, SYMMETRY_NONE) /** Initialize a LineIntegral object */ value LineIntegral_init(vm *v, int nargs, value *args) { @@ -4664,23 +5326,24 @@ value LineIntegral_fieldgradient(vm *v, int nargs, value *args) { if (integral_prepareref(MORPHO_GETINSTANCE(MORPHO_SELF(args)), info.mesh, MESH_GRADE_LINE, info.sel, &ref)) { info.g=MESH_GRADE_LINE; info.integrand=lineintegral_integrand; + info.start=integral_startfn; info.cloneref=integral_cloneref; info.freeref=integral_freeref; info.ref=&ref; - functional_mapnumericalfieldgradient(v, &info, &out); - } else morpho_runtimeerror(v, GRADSQ_ARGS); + if (functional_startmap(v, &info)) functional_mapnumericalfieldgradient(v, &info, &out); + } else morpho_runtimeerror(v, LINEINTEGRAL_ARGS); } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); return out; } MORPHO_BEGINCLASS(LineIntegral) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LineIntegral_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, LineIntegral_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, LineIntegral_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, LineIntegral_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, LineIntegral_fieldgradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, LineIntegral_hessian, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LineIntegral_init, MORPHO_FN_MUTATES|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, LineIntegral_integrand, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, LineIntegral_total, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, LineIntegral_gradient, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, LineIntegral_fieldgradient, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_HESSIAN_METHOD, LineIntegral_hessian, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -4693,13 +5356,14 @@ bool areaintegral_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int * double *x[nv]; bool success; - value qgrad[iref.nfields+1]; - for (int i=0; idim, MESH_GRADE_AREA, x, iref.nfields, quantities, &iref, out, &err); @@ -4750,16 +5417,21 @@ bool areaintegral_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int * for (int j=0; jval.count; j++) morpho_freeobject(l->val.data[j]); } morpho_freeobject(qgrad[i]); + if (MORPHO_ISLIST(qhess[i])) { + objectlist *l = MORPHO_GETLIST(qhess[i]); + for (int j=0; jval.count; j++) morpho_freeobject(l->val.data[j]); + } + morpho_freeobject(qhess[i]); } return success; } -FUNCTIONAL_METHOD(AreaIntegral, integrand, MESH_GRADE_AREA, integralref, integral_prepareref, functional_mapintegrand, areaintegral_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(AreaIntegral, integrand, MESH_GRADE_AREA, integralref, integral_prepareref, integral_startfn, functional_mapintegrand, areaintegral_integrand, NULL, AREAINTEGRAL_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(AreaIntegral, total, MESH_GRADE_AREA, integralref, integral_prepareref, functional_sumintegrand, areaintegral_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(AreaIntegral, total, MESH_GRADE_AREA, integralref, integral_prepareref, integral_startfn, functional_sumintegrand, areaintegral_integrand, NULL, AREAINTEGRAL_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(AreaIntegral, gradient, MESH_GRADE_AREA, integralref, integral_prepareref, functional_mapnumericalgradient, areaintegral_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(AreaIntegral, gradient, MESH_GRADE_AREA, integralref, integral_prepareref, integral_startfn, functional_mapnumericalgradient, areaintegral_integrand, NULL, AREAINTEGRAL_ARGS, SYMMETRY_NONE); /** Field gradients for Area Integrals */ value AreaIntegral_fieldgradient(vm *v, int nargs, value *args) { @@ -4772,22 +5444,23 @@ value AreaIntegral_fieldgradient(vm *v, int nargs, value *args) { if (integral_prepareref(MORPHO_GETINSTANCE(MORPHO_SELF(args)), info.mesh, MESH_GRADE_AREA, info.sel, &ref)) { info.g=MESH_GRADE_AREA; info.integrand=areaintegral_integrand; + info.start=integral_startfn; info.cloneref=integral_cloneref; info.freeref=integral_freeref; info.ref=&ref; - functional_mapnumericalfieldgradient(v, &info, &out); - } else morpho_runtimeerror(v, GRADSQ_ARGS); + if (functional_startmap(v, &info)) functional_mapnumericalfieldgradient(v, &info, &out); + } else morpho_runtimeerror(v, AREAINTEGRAL_ARGS); } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); return out; } MORPHO_BEGINCLASS(AreaIntegral) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LineIntegral_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, AreaIntegral_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, AreaIntegral_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, AreaIntegral_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, AreaIntegral_fieldgradient, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LineIntegral_init, MORPHO_FN_MUTATES|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, AreaIntegral_integrand, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, AreaIntegral_total, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, AreaIntegral_gradient, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, AreaIntegral_fieldgradient, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) MORPHO_ENDCLASS /* ---------------------------------------------- @@ -4800,13 +5473,14 @@ bool volumeintegral_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int double *x[nv]; bool success; - value qgrad[iref.nfields+1]; - for (int i=0; idim, MESH_GRADE_VOLUME, x, iref.nfields, quantities, &iref, out, &err); @@ -4852,16 +5529,21 @@ bool volumeintegral_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int for (int j=0; jval.count; j++) morpho_freeobject(l->val.data[j]); } morpho_freeobject(qgrad[i]); + if (MORPHO_ISLIST(qhess[i])) { + objectlist *l = MORPHO_GETLIST(qhess[i]); + for (int j=0; jval.count; j++) morpho_freeobject(l->val.data[j]); + } + morpho_freeobject(qhess[i]); } return success; } -FUNCTIONAL_METHOD(VolumeIntegral, integrand, MESH_GRADE_VOLUME, integralref, integral_prepareref, functional_mapintegrand, volumeintegral_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(VolumeIntegral, integrand, MESH_GRADE_VOLUME, integralref, integral_prepareref, integral_startfn, functional_mapintegrand, volumeintegral_integrand, NULL, VOLUMEINTEGRAL_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(VolumeIntegral, total, MESH_GRADE_VOLUME, integralref, integral_prepareref, functional_sumintegrand, volumeintegral_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(VolumeIntegral, total, MESH_GRADE_VOLUME, integralref, integral_prepareref, integral_startfn, functional_sumintegrand, volumeintegral_integrand, NULL, VOLUMEINTEGRAL_ARGS, SYMMETRY_NONE); -FUNCTIONAL_METHOD(VolumeIntegral, gradient, MESH_GRADE_VOLUME, integralref, integral_prepareref, functional_mapnumericalgradient, volumeintegral_integrand, NULL, GRADSQ_ARGS, SYMMETRY_NONE); +FUNCTIONAL_METHOD_START(VolumeIntegral, gradient, MESH_GRADE_VOLUME, integralref, integral_prepareref, integral_startfn, functional_mapnumericalgradient, volumeintegral_integrand, NULL, VOLUMEINTEGRAL_ARGS, SYMMETRY_NONE); /** Field gradients for Volume Integrals */ value VolumeIntegral_fieldgradient(vm *v, int nargs, value *args) { @@ -4874,22 +5556,670 @@ value VolumeIntegral_fieldgradient(vm *v, int nargs, value *args) { if (integral_prepareref(MORPHO_GETINSTANCE(MORPHO_SELF(args)), info.mesh, MESH_GRADE_VOLUME, info.sel, &ref)) { info.g=MESH_GRADE_VOLUME; info.integrand=volumeintegral_integrand; + info.start=integral_startfn; info.cloneref=integral_cloneref; info.freeref=integral_freeref; info.ref=&ref; - functional_mapnumericalfieldgradient(v, &info, &out); - } else morpho_runtimeerror(v, GRADSQ_ARGS); + if (functional_startmap(v, &info)) functional_mapnumericalfieldgradient(v, &info, &out); + } else morpho_runtimeerror(v, VOLUMEINTEGRAL_ARGS); } if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); return out; } MORPHO_BEGINCLASS(VolumeIntegral) -MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LineIntegral_init, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, VolumeIntegral_integrand, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, VolumeIntegral_total, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, VolumeIntegral_gradient, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, VolumeIntegral_fieldgradient, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, LineIntegral_init, MORPHO_FN_MUTATES|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, VolumeIntegral_integrand, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, VolumeIntegral_total, MORPHO_FN_REENTRANT|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, VolumeIntegral_gradient, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED), +MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, VolumeIntegral_fieldgradient, MORPHO_FN_REENTRANT|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS|MORPHO_FN_MULTITHREADED) +MORPHO_ENDCLASS + +/* ---------------------------------------------- + * Jump + * ---------------------------------------------- */ + +struct jumpref_s { + integralref integral; + grade parentgrade; + grade interfacegrade; + objectsparse *interfaceparents; + objectsparse *parentinterfaces; + objectsparse *parentvertices; + jumpstrategy strategy; +}; + +static bool jump_preparetopology(objectmesh *mesh, jumpref *ref) { + ref->parentgrade=mesh_maxgrade(mesh); + if (ref->parentgrade<1) return false; + + ref->interfacegrade=ref->parentgrade-1; + ref->interfaceparents=mesh_addconnectivityelement(mesh, ref->parentgrade, ref->interfacegrade); + ref->parentinterfaces=mesh_addconnectivityelement(mesh, ref->interfacegrade, ref->parentgrade); + ref->parentvertices=mesh_getconnectivityelement(mesh, 0, ref->parentgrade); + + return (ref->interfaceparents!=NULL && ref->parentinterfaces!=NULL && ref->parentvertices!=NULL); +} + +static bool jump_preparestrategy(jumpref *ref) { + ref->strategy=JUMP_STRATEGY_CENTROID_MODE; + + if (!MORPHO_ISDICTIONARY(ref->integral.method)) return true; + + objectdictionary *dict=MORPHO_GETDICTIONARY(ref->integral.method); + objectstring strategylabel = MORPHO_STATICSTRING(JUMP_STRATEGY_LABEL); + value val=MORPHO_NIL; + + if (!dictionary_get(&dict->dict, MORPHO_OBJECT(&strategylabel), &val)) return true; + if (!MORPHO_ISSTRING(val)) return false; + + char *strategy=MORPHO_GETCSTRING(val); + if (strcmp(strategy, JUMP_STRATEGY_CENTROID)==0) { + ref->strategy=JUMP_STRATEGY_CENTROID_MODE; + return true; + } + if (strcmp(strategy, JUMP_STRATEGY_QUADRATURE)==0) { + ref->strategy=JUMP_STRATEGY_QUADRATURE_MODE; + return true; + } + + return false; +} + +/** Initialize a Jump object. + For now this matches the existing integral optional-argument surface: + 'method', 'mref' and 'weightbyreference'. */ +static value Jump_init(vm *v, int nargs, value *args) { + return LineIntegral_init(v, nargs, args); +} + +/** Prepare a jump reference. + Shared functional metadata is handled by integral_prepareref; Jump only adds + codimension-1 topology needed for interior-interface traversal. */ +static bool jump_prepareref(objectinstance *self, objectmesh *mesh, grade g, objectselection *sel, jumpref *ref) { + ref->parentgrade=0; + ref->interfacegrade=0; + ref->interfaceparents=NULL; + ref->parentinterfaces=NULL; + ref->parentvertices=NULL; + ref->strategy=JUMP_STRATEGY_CENTROID_MODE; + + if (!integral_prepareref(self, mesh, g, sel, &ref->integral)) return false; + if (!jump_preparetopology(mesh, ref)) return false; + return jump_preparestrategy(ref); +} + +static bool jump_startfn(vm *v, functional_mapinfo *info) { + (void) v; + jumpref *ref = (jumpref *) info->ref; + return functional_preparefieldlist(ref->integral.fields, ref->integral.nfields, ref->parentgrade); +} + +/** Clone a jump reference with a substituted field. */ +static void *jump_cloneref(void *ref, objectfield *field, objectfield *sub) { + jumpref *nref = (jumpref *) ref; + jumpref *clone = MORPHO_MALLOC(sizeof(jumpref)); + + if (clone) { + *clone = *nref; + clone->integral.originalfields=nref->integral.originalfields; + clone->integral.fields=MORPHO_MALLOC(sizeof(value)*clone->integral.nfields); + if (!clone->integral.fields) { MORPHO_FREE(clone); return NULL; } + + for (int i=0; iintegral.nfields; i++) { + clone->integral.fields[i]=nref->integral.fields[i]; + if (MORPHO_ISFIELD(nref->integral.fields[i]) && + MORPHO_GETFIELD(nref->integral.fields[i])==field) { + clone->integral.fields[i]=MORPHO_OBJECT(sub); + } + } + } + + return clone; +} + +/** Free a cloned jump reference. */ +static void jump_freeref(void *ref) { + jumpref *nref = (jumpref *) ref; + MORPHO_FREE(nref->integral.fields); + MORPHO_FREE(ref); +} + +/** Get the adjacent parent elements for an interface. */ +static bool jump_getadjacentparents(jumpref *ref, elementid interfaceid, int *nparents, int **parents) { + if (!ref->interfaceparents) return false; + return mesh_getconnectivity(ref->interfaceparents, interfaceid, nparents, parents); +} + +/** Return mesh vertices outside the interface that still influence the jump term + through the two adjacent parent elements. */ +static bool jump_dependencies(functional_mapinfo *info, elementid id, varray_elementid *out) { + jumpref *ref = (jumpref *) info->ref; + int nparents=0, *parents=NULL; + + if (!jump_getadjacentparents(ref, id, &nparents, &parents)) return false; + if (nparents!=2) return true; + + int interface_nv=0, *interface_vid=NULL; + objectsparse *ifaceverts=NULL; + int n=0; + + if (!functional_countelements(NULL, info->mesh, ref->interfacegrade, &n, &ifaceverts)) return false; + (void) n; + if (!ifaceverts) return false; + if (!sparseccs_getrowindices(&ifaceverts->ccs, id, &interface_nv, &interface_vid)) return false; + + for (int p=0; pparentvertices, parents[p], &parent_nv, &parent_vid)) return false; + for (int j=0; jref; + int nparents=0, *parents=NULL; + + if (!jump_getadjacentparents(ref, id, &nparents, &parents)) return false; + if (nparents!=2) return true; + + for (int p=0; pparentinterfaces, parents[p], &nifaces, &ifaces)) return false; + for (int j=0; jnv=nv; + trace->vid=vid; + trace->quantities=MORPHO_MALLOC(sizeof(quantity)*ref->integral.nfields); + if (!trace->quantities) return false; + + for (int i=0; iintegral.nfields; i++) { + trace->quantities[i].nnodes=0; + trace->quantities[i].vals=NULL; + trace->quantities[i].ifn=NULL; + trace->quantities[i].ndof=0; + } + + if (!integral_preparequantities(&ref->integral, nv, vid, trace->quantities)) { + integral_clearquantities(ref->integral.nfields, trace->quantities); + MORPHO_FREE(trace->quantities); + trace->quantities=NULL; + return false; + } + + return true; +} + +static void jump_clearjumpside(jumpref *ref, jumpside *trace) { + if (trace->quantities) { + integral_clearquantities(ref->integral.nfields, trace->quantities); + MORPHO_FREE(trace->quantities); + trace->quantities=NULL; + } +} + +static void jump_clearinterfaceref(objectjumpinterfaceref *iref) { + jump_clearjumpside(iref->jref, &iref->qplus); + jump_clearjumpside(iref->jref, &iref->qminus); + if (iref->pluslambda) { + MORPHO_FREE(iref->pluslambda); + iref->pluslambda=NULL; + } + if (iref->minuslambda) { + MORPHO_FREE(iref->minuslambda); + iref->minuslambda=NULL; + } + if (iref->normal) { + object_free((object *) iref->normal); + iref->normal=NULL; + } +} + +static void jump_orderparents(int *parents, elementid *plusid, elementid *minusid) { + if (parents[0]dim; + for (int i=0; innodes; + double wts[nnodes]; + + if (q->ifn) { + (q->ifn) (lambda, wts); + } else { + if (nnodes!=1) return false; + wts[0]=1.0; + } + + return integrator_sumquantityweighted(nnodes, wts, q->vals, out); +} + +static bool jump_preparepointdata(objectjumpinterfaceref *iref, double *posn, value *qinterp) { + jumpref *ref=iref->jref; + double *xplus[iref->plusnv], *xminus[iref->minusnv]; + + if (!jump_getinterfacevertexpositions(iref->mesh, iref->plusnv, iref->plusvid, xplus) || + !jump_getinterfacevertexpositions(iref->mesh, iref->minusnv, iref->minusvid, xminus) || + !jump_parentlambda(iref->mesh->dim, ref->parentgrade, xplus, posn, iref->pluslambda) || + !jump_parentlambda(iref->mesh->dim, ref->parentgrade, xminus, posn, iref->minuslambda)) return false; + + iref->posn=posn; + iref->qinterpolated=qinterp; + + for (int i=0; iintegral.nfields; i++) { + if (!jump_interpolatequantity(&iref->qplus.quantities[i], ref->parentgrade, iref->pluslambda, &qinterp[i])) return false; + } + + return true; +} + +static bool jump_callintegrand(objectjumpinterfaceref *iref, double *posn, double *out) { + jumpref *ref=iref->jref; + value qinterp[ref->integral.nfields+1], args[ref->integral.nfields+1], outval=MORPHO_NIL; + objectmatrix mposn = MORPHO_STATICMATRIX(posn, iref->mesh->dim, 1); + + if (!jump_preparepointdata(iref, posn, qinterp)) return false; + + args[0]=MORPHO_OBJECT(&mposn); + for (int i=0; iintegral.nfields; i++) args[i+1]=qinterp[i]; + + if (!morpho_call(iref->v, ref->integral.integrand, ref->integral.nfields+1, args, &outval)) return false; + return morpho_valuetofloat(outval, out); +} + +static bool jump_integrandfn(unsigned int dim, double *t, double *x, unsigned int nquantity, value *quantity, void *ref, double *fout) { + objectjumpinterfaceref *iref = (objectjumpinterfaceref *) ref; + return jump_callintegrand(iref, x, fout); +} + +static bool jump_evaluatesidegradient(objectjumpinterfaceref *iref, int ifld, bool plus, double *grad) { + objectfield *fld = MORPHO_GETFIELD(iref->jref->integral.fields[ifld]); + jumpside *side = (plus ? &iref->qplus : &iref->qminus); + int nv = (plus ? iref->plusnv : iref->minusnv); + int *vid = (plus ? iref->plusvid : iref->minusvid); + double *lambda = (plus ? iref->pluslambda : iref->minuslambda); + int dim = iref->mesh->dim; + grade g = iref->jref->parentgrade; + + if (!MORPHO_ISFESPACE(fld->fnspc) || !MORPHO_ISNIL(fld->prototype)) return false; + + fespace *disc = MORPHO_GETFESPACE(fld->fnspc)->fespace; + if (!FESPACE_HASGRADIENT(disc)) return false; + + double *x[nv]; + if (!jump_getinterfacevertexpositions(iref->mesh, nv, vid, x)) return false; + + double invjdata[g*dim]; + objectmatrix invj = MORPHO_STATICMATRIX(invjdata, g, dim); + if (!integral_prepareinvjacobian(dim, g, x, &invj)) return false; + + int nnodes = disc->nnodes; + double gdata[nnodes*g]; + double fdata[nnodes*dim]; + objectmatrix gmat = MORPHO_STATICMATRIX(gdata, nnodes, g); + objectmatrix fmat = MORPHO_STATICMATRIX(fdata, nnodes, dim); + + fespace_gradient(disc, lambda, &gmat); + if (matrix_mul(&gmat, &invj, &fmat)!=LINALGERR_OK) return false; + + for (int i=0; iquantities[ifld].vals, &sum)) return false; + if (!morpho_valuetofloat(sum, &grad[i])) return false; + } + + return true; +} + +static bool jump_preparenormal(vm *v, objectjumpinterfaceref *iref) { + int dim=iref->mesh->dim; + double pluscentroid[dim], minuscentroid[dim], d[dim]; + + if (!jump_getelementcentroid(iref->mesh, iref->plusnv, iref->plusvid, pluscentroid)) return false; + if (!jump_getelementcentroid(iref->mesh, iref->minusnv, iref->minusvid, minuscentroid)) return false; + + functional_vecsub(dim, minuscentroid, pluscentroid, d); + + objectmatrix *mnormal = matrix_new(dim, 1, false); + if (!mnormal) return false; + + for (int i=0; ielements[i]=0.0; + + if (iref->g==0) { + for (int i=0; ielements[i]=d[i]; + } else if (iref->g==1) { + double t[dim], n[dim]; + + functional_vecsub(dim, iref->vertexposn[1], iref->vertexposn[0], t); + double tnorm=functional_vecnorm(dim, t); + if (tnormelements); + } else if (iref->g==2) { + if (dim!=3) { object_free((object *) mnormal); return false; } + + double s0[3], s1[3]; + functional_vecsub(3, iref->vertexposn[1], iref->vertexposn[0], s0); + functional_vecsub(3, iref->vertexposn[2], iref->vertexposn[1], s1); + functional_veccross(s0, s1, mnormal->elements); + } else { + object_free((object *) mnormal); + return false; + } + + double nnorm=functional_vecnorm(dim, mnormal->elements); + if (nnormelements, d)<0.0) { + functional_vecscale(dim, -1.0, mnormal->elements, mnormal->elements); + } + + nnorm=functional_vecnorm(dim, mnormal->elements); + if (nnormelements, mnormal->elements); + + iref->normal=mnormal; + return true; +} + +static bool jump_preparegeometry(vm *v, objectjumpinterfaceref *iref, double **vertexposn) { + iref->vertexposn=vertexposn; + if (iref->g==0) iref->interfacesize=1.0; + else if (!functional_elementsize(v, iref->mesh, iref->g, iref->id, iref->nv, iref->vid, &iref->interfacesize)) return false; + + return jump_preparenormal(v, iref); +} + +static bool jump_prepareinterfaceref(vm *v, objectmesh *mesh, jumpref *ref, elementid id, int nv, int *vid, double **vertexposn, int *parents, objectjumpinterfaceref *iref) { + int plusnv=0, minusnv=0; + int *plusvid=NULL, *minusvid=NULL; + + *iref = (objectjumpinterfaceref) MORPHO_STATICJUMPINTERFACEREF(mesh, ref->interfacegrade, id, nv, vid); + iref->v=v; + iref->jref=ref; + + jump_orderparents(parents, &iref->plusid, &iref->minusid); + + if (!mesh_getconnectivity(ref->parentvertices, iref->plusid, &plusnv, &plusvid)) return false; + if (!mesh_getconnectivity(ref->parentvertices, iref->minusid, &minusnv, &minusvid)) return false; + + iref->plusnv=plusnv; + iref->plusvid=plusvid; + iref->minusnv=minusnv; + iref->minusvid=minusvid; + iref->pluslambda=MORPHO_MALLOC(sizeof(double)*iref->plusnv); + iref->minuslambda=MORPHO_MALLOC(sizeof(double)*iref->minusnv); + if (!iref->pluslambda || !iref->minuslambda) { + jump_clearinterfaceref(iref); + return false; + } + + if (!jump_preparejumpside(ref, iref->plusnv, iref->plusvid, &iref->qplus)) { + jump_clearinterfaceref(iref); + return false; + } + if (!jump_preparejumpside(ref, iref->minusnv, iref->minusvid, &iref->qminus)) { + jump_clearinterfaceref(iref); + return false; + } + + if (!jump_preparegeometry(v, iref, vertexposn)) { + jump_clearinterfaceref(iref); + return false; + } + + return true; +} + +/** Basic Jump scan over codimension-1 entities. + This currently only identifies interior interfaces by checking that they + have exactly two adjacent parent elements. */ +static bool jump_scan_integrand(vm *v, objectmesh *mesh, elementid id, int nv, int *vid, void *r, double *out) { + jumpref *ref = (jumpref *) r; + int nparents=0, *parents=NULL; + double *x[nv]; + + if (!jump_getadjacentparents(ref, id, &nparents, &parents)) return false; + + /* Boundary interfaces or malformed topology are ignored for now. */ + if (nparents!=2) { *out=0.0; return true; } + + if (!jump_getinterfacevertexpositions(mesh, nv, vid, x)) return false; + + objectjumpinterfaceref iref; + if (!jump_prepareinterfaceref(v, mesh, ref, id, nv, vid, x, parents, &iref)) return false; + vm_settlvar(v, jumpinterfacehandle, MORPHO_OBJECT(&iref)); + + if (ref->strategy==JUMP_STRATEGY_CENTROID_MODE || ref->interfacegrade==0) { + double posn[mesh->dim]; + jump_centroid(mesh->dim, nv, x, posn); + if (!jump_callintegrand(&iref, posn, out)) { + vm_settlvar(v, jumpinterfacehandle, MORPHO_NIL); + jump_clearinterfaceref(&iref); + return false; + } + *out *= iref.interfacesize; + } else if (ref->strategy==JUMP_STRATEGY_QUADRATURE_MODE) { + double err=0.0; + if (!integrate(jump_integrandfn, MORPHO_GETDICTIONARY(ref->integral.method), morpho_geterror(v), mesh->dim, ref->interfacegrade, x, 0, NULL, &iref, out, &err)) { + vm_settlvar(v, jumpinterfacehandle, MORPHO_NIL); + jump_clearinterfaceref(&iref); + return false; + } + *out *= iref.interfacesize; + } else { + morpho_runtimeerror(v, JUMP_UNIMPL); + vm_settlvar(v, jumpinterfacehandle, MORPHO_NIL); + jump_clearinterfaceref(&iref); + return false; + } + + vm_settlvar(v, jumpinterfacehandle, MORPHO_NIL); + jump_clearinterfaceref(&iref); + return true; +} + +static value Jump_integrand(vm *v, int nargs, value *args) { + functional_mapinfo info; + jumpref ref; + value out=MORPHO_NIL; + + if (functional_validateargs(v, nargs, args, &info)) { + if (jump_prepareref(MORPHO_GETINSTANCE(MORPHO_SELF(args)), info.mesh, 0, info.sel, &ref)) { + info.g=ref.interfacegrade; + info.integrand=jump_scan_integrand; + info.start=jump_startfn; + info.ref=&ref; + if (functional_startmap(v, &info)) functional_mapintegrand(v, &info, &out); + } else morpho_runtimeerror(v, JUMP_UNIMPL); + } + if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); + return out; +} + +static value Jump_total(vm *v, int nargs, value *args) { + functional_mapinfo info; + jumpref ref; + value out=MORPHO_NIL; + + if (functional_validateargs(v, nargs, args, &info)) { + if (jump_prepareref(MORPHO_GETINSTANCE(MORPHO_SELF(args)), info.mesh, 0, info.sel, &ref)) { + info.g=ref.interfacegrade; + info.integrand=jump_scan_integrand; + info.start=jump_startfn; + info.ref=&ref; + if (functional_startmap(v, &info)) functional_sumintegrand(v, &info, &out); + } else morpho_runtimeerror(v, JUMP_UNIMPL); + } + + return out; +} + +static value Jump_gradient(vm *v, int nargs, value *args) { + functional_mapinfo info; + jumpref ref; + value out=MORPHO_NIL; + + if (functional_validateargs(v, nargs, args, &info)) { + if (jump_prepareref(MORPHO_GETINSTANCE(MORPHO_SELF(args)), info.mesh, 0, info.sel, &ref)) { + info.g=ref.interfacegrade; + info.integrand=jump_scan_integrand; + info.start=jump_startfn; + info.dependencies=jump_dependencies; + info.ref=&ref; + if (functional_startmap(v, &info)) functional_mapnumericalgradient(v, &info, &out); + } else morpho_runtimeerror(v, JUMP_UNIMPL); + } + if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); + return out; +} + +static value Jump_fieldgradient(vm *v, int nargs, value *args) { + functional_mapinfo info; + jumpref ref; + value out=MORPHO_NIL; + + if (functional_validateargs(v, nargs, args, &info)) { + if (jump_prepareref(MORPHO_GETINSTANCE(MORPHO_SELF(args)), info.mesh, 0, info.sel, &ref)) { + info.g=ref.interfacegrade; + info.integrand=jump_scan_integrand; + info.start=jump_startfn; + info.dependencies=NULL; + info.cloneref=jump_cloneref; + info.freeref=jump_freeref; + info.ref=&ref; + if (functional_startmap(v, &info)) functional_mapjumpnumericalfieldgradient(v, &info, ref.parentvertices, &ref, &out); + } else morpho_runtimeerror(v, JUMP_UNIMPL); + } + if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); + return out; +} + +static value integral_jumpdnfn(vm *v, int nargs, value *args) { + objectjumpinterfaceref *iref = jump_getinterfaceref(v); + if (!iref) { + morpho_runtimeerror(v, INTEGRAL_SPCLFN, JUMPDN_FUNCTION); + } else { + value q = MORPHO_GETARG(args, 0); + int ifld, xfld=-1; + + for (ifld=0; ifldjref->integral.nfields; ifld++) { + if (MORPHO_ISFIELD(q) && MORPHO_ISSAME(iref->jref->integral.originalfields[ifld], q)) break; + else if (iref->qinterpolated && MORPHO_ISSAME(iref->qinterpolated[ifld], q)) { + if (xfld>=0) { morpho_runtimeerror(v, INTEGRAL_AMBGSFLD); return MORPHO_NIL; } + xfld=ifld; + } + } + if (xfld>=0) ifld=xfld; + + if (ifld>=iref->jref->integral.nfields) { + morpho_runtimeerror(v, INTEGRAL_FLD); + return MORPHO_NIL; + } + + double gradplus[iref->mesh->dim], gradminus[iref->mesh->dim]; + if (!jump_evaluatesidegradient(iref, ifld, true, gradplus) || + !jump_evaluatesidegradient(iref, ifld, false, gradminus)) { + morpho_runtimeerror(v, JUMP_UNIMPL); + return MORPHO_NIL; + } + + double jp = functional_vecdot(iref->mesh->dim, gradplus, iref->normal->elements); + double jm = functional_vecdot(iref->mesh->dim, gradminus, iref->normal->elements); + return MORPHO_FLOAT(jp-jm); + } + return MORPHO_NIL; +} + +MORPHO_BEGINCLASS(Jump) +MORPHO_METHOD(MORPHO_INITIALIZER_METHOD, Jump_init, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(FUNCTIONAL_INTEGRAND_METHOD, Jump_integrand, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(FUNCTIONAL_TOTAL_METHOD, Jump_total, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(FUNCTIONAL_GRADIENT_METHOD, Jump_gradient, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(FUNCTIONAL_FIELDGRADIENT_METHOD, Jump_fieldgradient, BUILTIN_FLAGSEMPTY) MORPHO_ENDCLASS /* ********************************************************************** @@ -4945,13 +6275,19 @@ void functional_initialize(void) { builtin_addclass(LINEINTEGRAL_CLASSNAME, MORPHO_GETCLASSDEFINITION(LineIntegral), objclass); builtin_addclass(AREAINTEGRAL_CLASSNAME, MORPHO_GETCLASSDEFINITION(AreaIntegral), objclass); builtin_addclass(VOLUMEINTEGRAL_CLASSNAME, MORPHO_GETCLASSDEFINITION(VolumeIntegral), objclass); + builtin_addclass(JUMP_CLASSNAME, MORPHO_GETCLASSDEFINITION(Jump), objclass); builtin_addclass(NEMATIC_CLASSNAME, MORPHO_GETCLASSDEFINITION(Nematic), objclass); builtin_addclass(NEMATICELECTRIC_CLASSNAME, MORPHO_GETCLASSDEFINITION(NematicElectric), objclass); - builtin_addfunction(TANGENT_FUNCTION, integral_tangent, BUILTIN_FLAGSEMPTY); - builtin_addfunction(NORMAL_FUNCTION, integral_normal, BUILTIN_FLAGSEMPTY); - builtin_addfunction(GRAD_FUNCTION, integral_gradfn, BUILTIN_FLAGSEMPTY); - builtin_addfunction(CGTENSOR_FUNCTION, integral_cgfn, BUILTIN_FLAGSEMPTY); + builtin_addfunction(ELEMENTID_FUNCTION, integral_elementid, MORPHO_FN_THREADLOCAL | MORPHO_FN_THROWS); + builtin_addfunction(TANGENT_FUNCTION, integral_tangent, MORPHO_FN_THREADLOCAL | MORPHO_FN_ALLOCATES | MORPHO_FN_THROWS); + builtin_addfunction(NORMAL_FUNCTION, integral_normal, MORPHO_FN_THREADLOCAL | MORPHO_FN_ALLOCATES | MORPHO_FN_THROWS); + builtin_addfunction(GRAD_FUNCTION, integral_gradfn, MORPHO_FN_THREADLOCAL | MORPHO_FN_ALLOCATES | MORPHO_FN_THROWS); + builtin_addfunction(HESS_FUNCTION, integral_hessfn, MORPHO_FN_THREADLOCAL | MORPHO_FN_ALLOCATES | MORPHO_FN_THROWS); + builtin_addfunction(CGTENSOR_FUNCTION, integral_cgfn, MORPHO_FN_THREADLOCAL | MORPHO_FN_ALLOCATES | MORPHO_FN_THROWS); + builtin_addfunction(JUMPDN_FUNCTION, integral_jumpdnfn, MORPHO_FN_THREADLOCAL | MORPHO_FN_ALLOCATES | MORPHO_FN_THROWS); + builtin_addfunction(JACOBIAN_FUNCTION, integral_jacobian, MORPHO_FN_THREADLOCAL | MORPHO_FN_ALLOCATES | MORPHO_FN_THROWS); + builtin_addfunction(INVJACOBIAN_FUNCTION, integral_invjacobian, MORPHO_FN_THREADLOCAL | MORPHO_FN_ALLOCATES | MORPHO_FN_THROWS); morpho_defineerror(VOLUMEENCLOSED_ZERO, ERROR_HALT, VOLUMEENCLOSED_ZERO_MSG); morpho_defineerror(FUNC_INTEGRAND_MESH, ERROR_HALT, FUNC_INTEGRAND_MESH_MSG); @@ -4974,22 +6310,34 @@ void functional_initialize(void) { morpho_defineerror(NEMATICELECTRIC_ARGS, ERROR_HALT, NEMATICELECTRIC_ARGS_MSG); morpho_defineerror(FUNCTIONAL_ARGS, ERROR_HALT, FUNCTIONAL_ARGS_MSG); - + morpho_defineerror(INTEGRAL_ARGS, ERROR_HALT, INTEGRAL_ARGS_MSG); + morpho_defineerror(LINEINTEGRAL_ARGS, ERROR_HALT, LINEINTEGRAL_ARGS_MSG); + morpho_defineerror(AREAINTEGRAL_ARGS, ERROR_HALT, AREAINTEGRAL_ARGS_MSG); + morpho_defineerror(VOLUMEINTEGRAL_ARGS, ERROR_HALT, VOLUMEINTEGRAL_ARGS_MSG); morpho_defineerror(INTEGRAL_NFLDS, ERROR_HALT, INTEGRAL_NFLDS_MSG); morpho_defineerror(INTEGRAL_MTHDDCT, ERROR_HALT, INTEGRAL_MTHDDCT_MSG); morpho_defineerror(INTEGRAL_FLD, ERROR_HALT, INTEGRAL_FLD_MSG); morpho_defineerror(INTEGRAL_AMBGSFLD, ERROR_HALT, INTEGRAL_AMBGSFLD_MSG); morpho_defineerror(INTEGRAL_SPCLFN, ERROR_HALT, INTEGRAL_SPCLFN_MSG); morpho_defineerror(INTEGRAL_GRDEVL, ERROR_HALT, INTEGRAL_GRDEVL_MSG); + morpho_defineerror(INTEGRAL_HSSEVL, ERROR_HALT, INTEGRAL_HSSEVL_MSG); + morpho_defineerror(JUMP_UNIMPL, ERROR_HALT, JUMP_UNIMPL_MSG); + + morpho_defineerror(NRML_GRD, ERROR_HALT, NRML_GRD_MSG); + morpho_defineerror(TNGNT_GRD, ERROR_HALT, TNGNT_GRD_MSG); functional_poolinitialized = false; objectintegralelementreftype=object_addtype(&objectintegralelementrefdefn); + objectjumpinterfacereftype=object_addtype(&objectjumpinterfacerefdefn); elementhandle=vm_addtlvar(); + jumpinterfacehandle=vm_addtlvar(); tangenthandle=vm_addtlvar(); normlhandle=vm_addtlvar(); cauchygreenhandle=vm_addtlvar(); + jacobianhandle=vm_addtlvar(); + invjacobianhandle=vm_addtlvar(); morpho_addfinalizefn(functional_finalize); } diff --git a/src/geometry/functional.h b/src/geometry/functional.h index dcfb0bd1a..0a9673d8e 100644 --- a/src/geometry/functional.h +++ b/src/geometry/functional.h @@ -47,6 +47,10 @@ #define INTEGRAL_METHOD_PROPERTY "method" +#define JUMP_STRATEGY_LABEL "strategy" +#define JUMP_STRATEGY_QUADRATURE "quadrature" +#define JUMP_STRATEGY_CENTROID "centroid" + /* Functional methods */ #define FUNCTIONAL_INTEGRAND_METHOD "integrand" #define FUNCTIONAL_TOTAL_METHOD "total" @@ -56,10 +60,15 @@ #define FUNCTIONAL_INTEGRANDFORELEMENT_METHOD "integrandForElement" /* Special functions that can be used in integrands */ +#define ELEMENTID_FUNCTION "elementid" #define TANGENT_FUNCTION "tangent" #define NORMAL_FUNCTION "normal" #define GRAD_FUNCTION "grad" +#define HESS_FUNCTION "hess" #define CGTENSOR_FUNCTION "cgtensor" +#define JUMPDN_FUNCTION "jumpdn" +#define JACOBIAN_FUNCTION "jacobian" +#define INVJACOBIAN_FUNCTION "invjacobian" /* Functional names */ #define LENGTH_CLASSNAME "Length" @@ -80,6 +89,7 @@ #define LINEINTEGRAL_CLASSNAME "LineIntegral" #define AREAINTEGRAL_CLASSNAME "AreaIntegral" #define VOLUMEINTEGRAL_CLASSNAME "VolumeIntegral" +#define JUMP_CLASSNAME "Jump" #define NEMATIC_CLASSNAME "Nematic" #define NEMATICELECTRIC_CLASSNAME "NematicElectric" @@ -106,7 +116,10 @@ #define INTEGRAL_FLD_MSG "Can't identify field." #define INTEGRAL_GRDEVL "IntgrlGrdEvl" -#define INTEGRAL_GRDEVL_MSG "Gradient evaluation failed." +#define INTEGRAL_GRDEVL_MSG "Gradient evaluation failed or is unsupported by the finite element space." + +#define INTEGRAL_HSSEVL "IntgrlHssEvl" +#define INTEGRAL_HSSEVL_MSG "Hessian evaluation failed or is unsupported by the finite element space." #define INTEGRAL_AMBGSFLD "IntgrlAmbgsFld" #define INTEGRAL_AMBGSFLD_MSG "Field reference is ambigious: call with a Field object." @@ -114,9 +127,27 @@ #define INTEGRAL_SPCLFN "IntgrlSpclFn" #define INTEGRAL_SPCLFN_MSG "Special function '%s' must not be called outside of an Integral." +#define JUMP_UNIMPL "JumpUnimpl" +#define JUMP_UNIMPL_MSG "Jump is not implemented yet." + #define INTEGRAL_NFLDS "IntgrlNFlds" #define INTEGRAL_NFLDS_MSG "Incorrect number of Fields provided for integrand function." +#define LINEINTEGRAL_ARGS "LnIntArgs" +#define LINEINTEGRAL_ARGS_MSG "LineIntegral requires a callable argument, followed by zero or more Fields." + +#define AREAINTEGRAL_ARGS "ArIntArgs" +#define AREAINTEGRAL_ARGS_MSG "AreaIntegral requires a callable argument, followed by zero or more Fields." + +#define VOLUMEINTEGRAL_ARGS "VolIntArgs" +#define VOLUMEINTEGRAL_ARGS_MSG "VolumeIntegral requires a callable argument, followed by zero or more Fields." + +#define NRML_GRD "NormlGrade" +#define NRML_GRD_MSG "Normal can only be used on elements of grade 2." + +#define TNGNT_GRD "TngntGrade" +#define TNGNT_GRD_MSG "Tangent can only be used on elements of grade 1." + #define VOLUMEENCLOSED_ZERO "VolEnclZero" #define VOLUMEENCLOSED_ZERO_MSG "VolumeEnclosed detected an element of zero size. Check that a mesh point is not coincident with the origin." @@ -180,6 +211,9 @@ typedef bool (functional_fieldgradient) (vm *v, objectmesh *mesh, elementid id, struct s_functional_mapinfo; // Resolve circular typedef dependency +/** Optional start function called before a functional evaluation begins */ +typedef bool (functional_start) (vm *v, struct s_functional_mapinfo *info); + /** Clone reference function */ typedef void * (functional_cloneref) (void *ref, objectfield *field, objectfield *sub); @@ -198,6 +232,7 @@ typedef struct s_functional_mapinfo { functional_integrand *integrand; // Integrand function functional_gradient *grad; // Gradient functional_fieldgradient *fieldgrad; // Field gradient + functional_start *start; // Optional preflight hook functional_dependencies *dependencies; // Dependencies functional_cloneref *cloneref; // Clone a reference with a given field substituted functional_freeref *freeref; // Free a reference @@ -218,6 +253,7 @@ bool functional_mapgradient(vm *v, functional_mapinfo *info, value *out); bool functional_mapfieldgradient(vm *v, functional_mapinfo *info, value *out); bool functional_mapnumericalgradient(vm *v, functional_mapinfo *info, value *out); bool functional_mapnumericalfieldgradient(vm *v, functional_mapinfo *info, value *out); +bool functional_startmap(vm *v, functional_mapinfo *info); void functional_vecadd(unsigned int n, double *a, double *b, double *out); void functional_vecaddscale(unsigned int n, double *a, double lambda, double *b, double *out); @@ -243,26 +279,32 @@ bool functional_elementgradient(vm *v, objectmesh *mesh, grade g, elementid id, } /** Evaluate an integrand */ -#define FUNCTIONAL_INTEGRAND(name, grade, integrandfn) value name##_integrand(vm *v, int nargs, value *args) { \ +#define FUNCTIONAL_INTEGRAND(name, grade, integrandfn) \ + FUNCTIONAL_INTEGRAND_START(name, grade, NULL, integrandfn) + +#define FUNCTIONAL_INTEGRAND_START(name, grade, startfn, integrandfn) value name##_integrand(vm *v, int nargs, value *args) { \ functional_mapinfo info; \ value out=MORPHO_NIL; \ \ if (functional_validateargs(v, nargs, args, &info)) { \ - info.g = grade; info.integrand = integrandfn; \ - functional_mapintegrand(v, &info, &out); \ + info.g = grade; info.start = startfn; info.integrand = integrandfn; \ + if (functional_startmap(v, &info)) functional_mapintegrand(v, &info, &out); \ } \ if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); \ return out; \ } /** Evaluate an integrand at an element */ -#define FUNCTIONAL_INTEGRANDFORELEMENT(name, grade, integrandfn) value name##_integrandForElement(vm *v, int nargs, value *args) { \ +#define FUNCTIONAL_INTEGRANDFORELEMENT(name, grade, integrandfn) \ + FUNCTIONAL_INTEGRANDFORELEMENT_START(name, grade, NULL, integrandfn) + +#define FUNCTIONAL_INTEGRANDFORELEMENT_START(name, grade, startfn, integrandfn) value name##_integrandForElement(vm *v, int nargs, value *args) { \ functional_mapinfo info; \ value out=MORPHO_NIL; \ \ if (functional_validateargs(v, nargs, args, &info)) { \ - info.g = grade; info.integrand = integrandfn; \ - functional_mapintegrandforelement(v, &info, &out); \ + info.g = grade; info.start = startfn; info.integrand = integrandfn; \ + if (functional_startmap(v, &info)) functional_mapintegrandforelement(v, &info, &out); \ } \ if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); \ return out; \ @@ -270,13 +312,16 @@ bool functional_elementgradient(vm *v, objectmesh *mesh, grade g, elementid id, /** Evaluate a gradient */ #define FUNCTIONAL_GRADIENT(name, grade, gradientfn, symbhvr) \ + FUNCTIONAL_GRADIENT_START(name, grade, NULL, gradientfn, symbhvr) + +#define FUNCTIONAL_GRADIENT_START(name, grade, startfn, gradientfn, symbhvr) \ value name##_gradient(vm *v, int nargs, value *args) { \ functional_mapinfo info; \ value out=MORPHO_NIL; \ \ if (functional_validateargs(v, nargs, args, &info)) { \ - info.g = grade; info.grad = gradientfn; info.sym = symbhvr; \ - functional_mapgradient(v, &info, &out); \ + info.g = grade; info.start = startfn; info.grad = gradientfn; info.sym = symbhvr; \ + if (functional_startmap(v, &info)) functional_mapgradient(v, &info, &out); \ } \ if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); \ \ @@ -285,13 +330,16 @@ value name##_gradient(vm *v, int nargs, value *args) { \ /** Evaluate a gradient */ #define FUNCTIONAL_NUMERICALGRADIENT(name, grade, integrandfn, symbhvr) \ + FUNCTIONAL_NUMERICALGRADIENT_START(name, grade, NULL, integrandfn, symbhvr) + +#define FUNCTIONAL_NUMERICALGRADIENT_START(name, grade, startfn, integrandfn, symbhvr) \ value name##_gradient(vm *v, int nargs, value *args) { \ functional_mapinfo info; \ value out=MORPHO_NIL; \ \ if (functional_validateargs(v, nargs, args, &info)) { \ - info.g = grade; info.integrand = integrandfn; info.sym = symbhvr; \ - functional_mapnumericalgradient(v, &info, &out); \ + info.g = grade; info.start = startfn; info.integrand = integrandfn; info.sym = symbhvr; \ + if (functional_startmap(v, &info)) functional_mapnumericalgradient(v, &info, &out); \ } \ if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); \ \ @@ -300,13 +348,16 @@ value name##_gradient(vm *v, int nargs, value *args) { \ /** Total an integrand */ #define FUNCTIONAL_TOTAL(name, grade, totalfn) \ + FUNCTIONAL_TOTAL_START(name, grade, NULL, totalfn) + +#define FUNCTIONAL_TOTAL_START(name, grade, startfn, totalfn) \ value name##_total(vm *v, int nargs, value *args) { \ functional_mapinfo info; \ value out=MORPHO_NIL; \ \ if (functional_validateargs(v, nargs, args, &info)) { \ - info.g = grade; info.integrand = totalfn; \ - functional_sumintegrand(v, &info, &out); \ + info.g = grade; info.start = startfn; info.integrand = totalfn; \ + if (functional_startmap(v, &info)) functional_sumintegrand(v, &info, &out); \ } \ \ return out; \ @@ -314,13 +365,16 @@ value name##_total(vm *v, int nargs, value *args) { \ /** Hessian */ #define FUNCTIONAL_HESSIAN(name, grade, totalfn) \ + FUNCTIONAL_HESSIAN_START(name, grade, NULL, totalfn) + +#define FUNCTIONAL_HESSIAN_START(name, grade, startfn, totalfn) \ value name##_hessian(vm *v, int nargs, value *args) { \ functional_mapinfo info; \ value out=MORPHO_NIL; \ \ if (functional_validateargs(v, nargs, args, &info)) { \ - info.g = grade; info.integrand = totalfn; \ - functional_mapnumericalhessian(v, &info, &out); \ + info.g = grade; info.start = startfn; info.integrand = totalfn; \ + if (functional_startmap(v, &info)) functional_mapnumericalhessian(v, &info, &out); \ } \ if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); \ \ @@ -328,7 +382,10 @@ value name##_hessian(vm *v, int nargs, value *args) { \ } /* Alternative way of defining methods that use a reference */ -#define FUNCTIONAL_METHOD(class, name, grade, reftype, prepare, integrandfn, integrandmapfn, deps, err, symbhvr) value class##_##name(vm *v, int nargs, value *args) { \ +#define FUNCTIONAL_METHOD(class, name, grade, reftype, prepare, integrandfn, integrandmapfn, deps, err, symbhvr) \ + FUNCTIONAL_METHOD_START(class, name, grade, reftype, prepare, NULL, integrandfn, integrandmapfn, deps, err, symbhvr) + +#define FUNCTIONAL_METHOD_START(class, name, grade, reftype, prepare, startfn, integrandfn, integrandmapfn, deps, err, symbhvr) value class##_##name(vm *v, int nargs, value *args) { \ functional_mapinfo info; \ reftype ref; \ value out=MORPHO_NIL; \ @@ -336,11 +393,12 @@ value name##_hessian(vm *v, int nargs, value *args) { \ if (functional_validateargs(v, nargs, args, &info)) { \ if (prepare(MORPHO_GETINSTANCE(MORPHO_SELF(args)), info.mesh, grade, info.sel, &ref)) { \ info.integrand = integrandmapfn; \ + info.start = startfn; \ info.dependencies = deps, \ info.sym = symbhvr; \ info.g = grade; \ info.ref = &ref; \ - integrandfn(v, &info, &out); \ + if (functional_startmap(v, &info) && !integrandfn(v, &info, &out) && !morpho_checkerror(morpho_geterror(v))) morpho_runtimeerror(v, err); \ } else morpho_runtimeerror(v, err); \ } \ if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); \ diff --git a/src/geometry/integrate.c b/src/geometry/integrate.c index 34e379bf1..77cc05124 100644 --- a/src/geometry/integrate.c +++ b/src/geometry/integrate.c @@ -14,7 +14,7 @@ #include "morpho.h" #include "classes.h" -#include "matrix.h" +#include "linalg.h" #include "sparse.h" #include "geometry.h" @@ -24,7 +24,7 @@ bool integrate_recognizequantities(unsigned int nquantity, value *quantity, valu if (MORPHO_ISFLOAT(quantity[i])) { out[i]=MORPHO_FLOAT(0); } else if (MORPHO_ISMATRIX(quantity[i])) { - out[i]=MORPHO_OBJECT(object_clonematrix(MORPHO_GETMATRIX(quantity[i]))); + out[i]=MORPHO_OBJECT(matrix_clone(MORPHO_GETMATRIX(quantity[i]))); } else return false; } } @@ -84,7 +84,7 @@ void integrate_interpolatequantitiesline(unsigned int dim, double t, unsigned in *out=(MORPHO_ISMATRIX(qout[i]) ? MORPHO_GETMATRIX(qout[i]): NULL); if (!out) { - out = object_clonematrix(m0); + out = matrix_clone(m0); qout[i]=MORPHO_OBJECT(out); } @@ -265,7 +265,7 @@ void integrate_interpolatequantitiestri(unsigned int dim, double *lambda, unsign *out=(MORPHO_ISMATRIX(qout[i]) ? MORPHO_GETMATRIX(qout[i]): NULL); if (!out) { - out = object_clonematrix(m0); + out = matrix_clone(m0); qout[i]=MORPHO_OBJECT(out); } @@ -603,7 +603,7 @@ void integrate_interpolatequantitiesvol(unsigned int dim, double *lambda, unsign *out=(MORPHO_ISMATRIX(qout[i]) ? MORPHO_GETMATRIX(qout[i]): NULL); if (!out) { - out = object_clonematrix(m0); + out = matrix_clone(m0); qout[i]=MORPHO_OBJECT(out); } @@ -2215,28 +2215,33 @@ int integrator_addelement(integrator *integrate, int *vids) { } /** Process the list of quantities given */ -void integrator_initializequantities(integrator *integrate, int nq, quantity *quantity) { +bool integrator_initializequantities(integrator *integrate, int nq, quantity *quantity) { integrate->nquantity=nq; integrate->quantity=quantity; for (int i=0; iqval[i]=q; } else if (MORPHO_ISMATRIX(q)) { objectmatrix *m = MORPHO_GETMATRIX(q); - quantity[i].ndof=matrix_countdof(m); + quantity[i].ndof=(int) matrix_countdof(m); - objectmatrix *new = object_clonematrix(m); // Use a copy of the matrix + objectmatrix *new = matrix_clone(m); // Use a copy of the matrix + if (!new) return false; integrate->qval[i]=MORPHO_OBJECT(new); - } else return; + } else return false; } + return true; } /** Frees up any objects used in the quantities list */ void integrator_finalizequantities(integrator *integrate) { - for (int i=0; inquantity; i++) morpho_freeobject(integrate->qval[i]); + for (int i=0; inquantity; i++) { + if (MORPHO_ISOBJECT(integrate->qval[i])) morpho_freeobject(integrate->qval[i]); + } } /** Retrieves the vertex pointers given an elementid. @@ -2396,7 +2401,7 @@ bool integrator_sumquantityweighted(int n, double *wts, value *q, value *out) { } else if (MORPHO_ISMATRIX(q[0])) { objectmatrix *sum = MORPHO_GETMATRIX(*out); matrix_zero(sum); - for (int j=0; jqval=qval; - integrator_initializequantities(integrate, nquantity, quantity); + if (!integrator_initializequantities(integrate, nquantity, quantity)) return false; // Create first element, which corresponds to the reference element int vids[integrate->nbary]; @@ -2785,7 +2790,7 @@ bool integrator_integrate(integrator *integrate, integrandfunction *integrand, i quadratureworkitem work; work.weight = 1.0; work.elementid = elid; - integrator_quadrature(integrate, integrate->rule, &work); // Perform initial quadrature + if (!integrator_quadrature(integrate, integrate->rule, &work)) goto integrator_integrate_error; // Perform initial quadrature integrator_pushworkitem(integrate, &work); integrator_estimate(integrate); // Initial estimate @@ -2802,7 +2807,9 @@ bool integrator_integrate(integrator *integrate, integrandfunction *integrand, i quadratureworkitem newitems[integrate->subdivide->nels]; if (!integrator_subdivide(integrate, &work, &nels, newitems)) goto integrator_integrate_error; - for (int k=0; krule, &newitems[k]); + for (int k=0; krule, &newitems[k])) goto integrator_integrate_error; + } // Error estimate integrator_sharpenerrorestimate(integrate, &work, nels, newitems); diff --git a/src/geometry/mesh.c b/src/geometry/mesh.c index 903268a6d..59826cbeb 100644 --- a/src/geometry/mesh.c +++ b/src/geometry/mesh.c @@ -13,7 +13,7 @@ #include "file.h" #include "parse.h" #include "sparse.h" -#include "matrix.h" +#include "linalg.h" #include "selection.h" // Temporary include @@ -79,7 +79,7 @@ objectmesh *object_newmesh(unsigned int dim, unsigned int nv, double *v) { new->dim=dim; new->conn=NULL; - new->vert=object_newmatrix(dim, nv, false); + new->vert=matrix_new(dim, nv, false); new->link=NULL; if (new->vert) { mesh_link(new, (object *) new->vert); @@ -129,7 +129,7 @@ void mesh_delink(objectmesh *mesh, object *obj) { /** Gets vertex coordinates */ bool mesh_getvertexcoordinates(objectmesh *mesh, elementid id, double *out) { double *coords; - if (matrix_getcolumn(mesh->vert, id, &coords)) { + if (matrix_getcolumnptr(mesh->vert, id, &coords)==LINALGERR_OK) { for (unsigned int i=0; idim; i++) out[i]=coords[i]; return true; } @@ -139,7 +139,7 @@ bool mesh_getvertexcoordinates(objectmesh *mesh, elementid id, double *out) { /** Gets vertex coordinates as a list */ bool mesh_getvertexcoordinatesaslist(objectmesh *mesh, elementid id, double **out) { double *coords=NULL; - if (matrix_getcolumn(mesh->vert, id, &coords)) { + if (matrix_getcolumnptr(mesh->vert, id, &coords)==LINALGERR_OK) { *out=coords; } return coords; @@ -147,14 +147,14 @@ bool mesh_getvertexcoordinatesaslist(objectmesh *mesh, elementid id, double **ou /** Gets vertex coordinates */ bool mesh_setvertexcoordinates(objectmesh *mesh, elementid id, double *x) {; - return matrix_setcolumn(mesh->vert, id, x); + return matrix_setcolumnptr(mesh->vert, id, x); } /** Gets vertex coordinates as a value list */ bool mesh_getvertexcoordinatesasvalues(objectmesh *mesh, elementid id, value *val) { double *x=NULL; // The vertex positions - bool success=matrix_getcolumn(mesh->vert, id, &x); + bool success=(matrix_getcolumnptr(mesh->vert, id, &x)==LINALGERR_OK); if (success) { for (unsigned int i=0; idim; i++) val[i]=MORPHO_FLOAT(x[i]); @@ -163,6 +163,51 @@ bool mesh_getvertexcoordinatesasvalues(objectmesh *mesh, elementid id, value *va return success; } +bool mesh_getbarycentriccoordinates(objectmesh *mesh, grade g, elementid id, double *x, double *lambda) { + if (g<1 || g>mesh_maxgrade(mesh)) return false; + + objectsparse *conn=mesh_getconnectivityelement(mesh, 0, g); + if (!conn) return false; + + int nentries, *entries; + if (!mesh_getconnectivity(conn, id, &nentries, &entries) || nentries!=g+1) return false; + + double *verts[4]; + for (int i=0; idim], edges[g][mesh->dim]; + objectmatrix gram = MORPHO_STATICMATRIX(gramdata, g, g); + objectmatrix rhs = MORPHO_STATICMATRIX(rhsdata, g, 1); + matrix_zero(&gram); + matrix_zero(&rhs); + + functional_vecsub(mesh->dim, x, verts[0], dx); + for (int i=0; idim, verts[i+1], verts[0], edges[i]); + } + + for (int i=0; idim, edges[i], dx); + for (int j=0; jdim, edges[i], edges[j]); + } + } + bool success=(matrix_solvesmall(&gram, &rhs)==LINALGERR_OK); + if (success) { + double sum=0.0; + for (int i=0; idim @@ -175,7 +220,7 @@ bool mesh_nearestvertex(objectmesh *mesh, double *x, elementid *id, double *sepa elementid bestid=0; for (elementid i=0; ivert, i, &vx)) return false; + if (matrix_getcolumnptr(mesh->vert, i, &vx)!=LINALGERR_OK) return false; sep=0; for (int k=0; kdim; k++) sep+=(vx[k]-x[k])*(vx[k]-x[k]); if (i==0 || sepvert->nrows; j++) { double x; - if (matrix_getelement(m->vert, j, i, &x)) { + if (matrix_getelement(m->vert, j, i, &x) == LINALGERR_OK) { fprintf(f, "%g ", x); } } @@ -1123,10 +1168,10 @@ value Mesh_vertexposition(vm *v, int nargs, value *args) { unsigned int id=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); double *vals; - if (matrix_getcolumn(m->vert, id, &vals)) { - objectmatrix *new=object_newmatrix(m->dim, 1, true); + if (matrix_getcolumnptr(m->vert, id, &vals)==LINALGERR_OK) { + objectmatrix *new=matrix_new(m->dim, 1, true); if (new) { - matrix_setcolumn(new, 0, vals); + matrix_setcolumnptr(new, 0, vals); out=MORPHO_OBJECT(new); morpho_bindobjects(v, 1, &out); } @@ -1145,7 +1190,7 @@ value Mesh_setvertexposition(vm *v, int nargs, value *args) { unsigned int id=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); objectmatrix *mat = MORPHO_GETMATRIX(MORPHO_GETARG(args, 1)); - if (!matrix_setcolumn(m->vert, id, mat->elements)) morpho_runtimeerror(v, MESH_INVLDID); + if (matrix_setcolumnptr(m->vert, id, mat->elements)!=LINALGERR_OK) morpho_runtimeerror(v, MESH_INVLDID); } else morpho_runtimeerror(v, MESH_STVRTPSNARGS); return MORPHO_NIL; @@ -1276,6 +1321,43 @@ value Mesh_count(vm *v, int nargs, value *args) { return out; } +value Mesh_barycentric(vm *v, int nargs, value *args) { + objectmesh *m=MORPHO_GETMESH(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==3 && MORPHO_ISINTEGER(MORPHO_GETARG(args, 0)) && + MORPHO_ISINTEGER(MORPHO_GETARG(args, 1)) && + MORPHO_ISMATRIX(MORPHO_GETARG(args, 2))) { + grade g=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + elementid id=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); + objectmatrix *x=MORPHO_GETMATRIX(MORPHO_GETARG(args, 2)); + + if (x->nrows!=m->dim || x->ncols!=1) { + morpho_runtimeerror(v, MESH_BARYDIM); + return MORPHO_NIL; + } + if (g<1 || g>mesh_maxgrade(m)) { + morpho_runtimeerror(v, MESH_BARYFAILED); + return MORPHO_NIL; + } + + objectmatrix *lambda=matrix_new(g+1, 1, true); + if (!lambda) { + morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + return MORPHO_NIL; + } + if (!mesh_getbarycentriccoordinates(m, g, id, x->elements, lambda->elements)) { + object_free((object *) lambda); + morpho_runtimeerror(v, MESH_BARYFAILED); + return MORPHO_NIL; + } + + out=morpho_wrapandbind(v, (object *) lambda); + } else morpho_runtimeerror(v, MESH_BARYARGS); + + return out; +} + /** Clones a mesh */ value Mesh_clone(vm *v, int nargs, value *args) { value out=MORPHO_NIL; @@ -1289,20 +1371,21 @@ value Mesh_clone(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Mesh) -MORPHO_METHOD(MORPHO_PRINT_METHOD, Mesh_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SAVE_METHOD, Mesh_save, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MESH_VERTEXMATRIX_METHOD, Mesh_vertexmatrix, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MESH_SETVERTEXMATRIX_METHOD, Mesh_setvertexmatrix, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MESH_VERTEXPOSITION_METHOD, Mesh_vertexposition, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MESH_SETVERTEXPOSITION_METHOD, Mesh_setvertexposition, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MESH_RESETCONNECTIVITY_METHOD, Mesh_resetconnectivity, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MESH_CONNECTIVITYMATRIX_METHOD, Mesh_connectivitymatrix, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MESH_ADDGRADE_METHOD, Mesh_addgrade, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MESH_REMOVEGRADE_METHOD, Mesh_removegrade, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MESH_ADDSYMMETRY_METHOD, Mesh_addsymmetry, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MESH_MAXGRADE_METHOD, Mesh_maxgrade, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_COUNT_METHOD, Mesh_count, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Mesh_clone, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_PRINT_METHOD, Mesh_print, MORPHO_FN_IO), +MORPHO_METHOD(MORPHO_SAVE_METHOD, Mesh_save, MORPHO_FN_IO), +MORPHO_METHOD(MESH_VERTEXMATRIX_METHOD, Mesh_vertexmatrix, MORPHO_FN_PUREFN), +MORPHO_METHOD(MESH_SETVERTEXMATRIX_METHOD, Mesh_setvertexmatrix, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MESH_VERTEXPOSITION_METHOD, Mesh_vertexposition, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MESH_SETVERTEXPOSITION_METHOD, Mesh_setvertexposition, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MESH_RESETCONNECTIVITY_METHOD, Mesh_resetconnectivity, MORPHO_FN_MUTATES), +MORPHO_METHOD(MESH_CONNECTIVITYMATRIX_METHOD, Mesh_connectivitymatrix, MORPHO_FN_MUTATES|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MESH_ADDGRADE_METHOD, Mesh_addgrade, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MESH_REMOVEGRADE_METHOD, Mesh_removegrade, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MESH_ADDSYMMETRY_METHOD, Mesh_addsymmetry, MORPHO_FN_MUTATES|MORPHO_FN_REENTRANT|MORPHO_FN_THROWS), +MORPHO_METHOD(MESH_BARYCENTRIC_METHOD, Mesh_barycentric, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MESH_MAXGRADE_METHOD, Mesh_maxgrade, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_COUNT_METHOD, Mesh_count, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_CLONE_METHOD, Mesh_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS) MORPHO_ENDCLASS /* ********************************************************************** @@ -1316,7 +1399,7 @@ void mesh_initialize(void) { for (unsigned int i=0; incols; if (matrix->ncols!=nv) { - morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + morpho_runtimeerror(v, LINALG_INCOMPATIBLEMATRICES); return; } @@ -196,9 +196,7 @@ void selection_selectwithmatrix(vm *v, objectselection *sel, value fn, objectmat value ret=MORPHO_NIL; // Return value for (elementid i=0; i + +#include "linalg.h" +#include "format.h" +#include "cmplx.h" + +objecttype objectcomplexmatrixtype; + +/* ********************************************************************** + * ComplexMatrix utility functions + * ********************************************************************** */ + +/* ---------------------- + * Callbacks + * ---------------------- */ + +static void _printelfn(vm *v, double *el) { + objectcomplex cmplx = MORPHO_STATICCOMPLEX(el[0], el[1]); + complex_print(v, &cmplx); +} + +static bool _printeltobufffn(varray_char *out, char *format, double *el) { + if (!format_printtobuffer(MORPHO_FLOAT(el[0]), format, out)) return false; + varray_charadd(out, " ", 1); + varray_charadd(out, (el[1]<0 ? "-" : "+"), 1); + if (!format_printtobuffer(MORPHO_FLOAT(fabs(el[1])), format, out)) return false; + varray_charadd(out, "im", 2); + return true; +} + +static value _getelfn(vm *v, double *el) { + objectcomplex *new = object_newcomplex(el[0], el[1]); + return morpho_wrapandbind(v, (object *) new); +} + +static linalgError_t _setelfn(vm *v, value in, double *el) { + if (MORPHO_ISCOMPLEX(in)) { + *((MorphoComplex *) el) = MORPHO_GETCOMPLEX(in)->Z; + } else if (morpho_valuetofloat(in, el)) { + el[1] = 0.0; // Set imaginary part to zero + } else return LINALGERR_NON_NUMERICAL; + return LINALGERR_OK; +} + +/** Evaluate norms */ +static double _normfn(objectmatrix *a, matrix_norm_t nrm) { + char cnrm = matrix_normtolapack(nrm); + int nrows=a->nrows, ncols=a->ncols; + +#ifdef MORPHO_LINALG_USE_LAPACKE + return LAPACKE_zlange(LAPACK_COL_MAJOR, cnrm, a->nrows, a->ncols, (linalg_complexdouble_t *) a->elements, a->nrows); +#else + double work[a->nrows]; + return zlange_(&cnrm, &nrows, &ncols, (linalg_complexdouble_t *) a->elements, &nrows, work); +#endif +} + +/** Low level linear solve */ +static linalgError_t _solve(objectmatrix *a, objectmatrix *b, int *pivot) { + int n=a->nrows, nrhs = b->ncols, info; + +#ifdef MORPHO_LINALG_USE_LAPACKE + info=LAPACKE_zgesv(LAPACK_COL_MAJOR, n, nrhs, (linalg_complexdouble_t *) a->elements, n, pivot, (linalg_complexdouble_t *) b->elements, n); +#else + zgesv_(&n, &nrhs, (linalg_complexdouble_t *) a->elements, + &n, pivot, (linalg_complexdouble_t *) b->elements, &n, &info); +#endif + + return (info==0 ? LINALGERR_OK : (info>0 ? LINALGERR_MATRIX_SINGULAR : LINALGERR_LAPACK_INVLD_ARGS)); +} + +/** Low level eigensolver */ +static linalgError_t _eigen(objectmatrix *a, MorphoComplex *w, objectmatrix *vec) { + int info, n=a->nrows; + +#ifdef MORPHO_LINALG_USE_LAPACKE + lapack_complex_double dummy; // Win32 lapacke seems to require we never pass null pointers + info = LAPACKE_zgeev( + LAPACK_COL_MAJOR, + 'N', (vec ? 'V' : 'N'), + n, + (lapack_complex_double *) a->elements, n, + (lapack_complex_double *) w, + &dummy, 1, + (vec ? (lapack_complex_double *) vec->elements : &dummy), (vec ? (lapack_int) n : 1)); +#else + int lwork=4*n; MorphoComplex work[4*n]; double rwork[2*n]; + zgeev_("N", (vec ? "V" : "N"), &n, (linalg_complexdouble_t *) a->elements, &n, (linalg_complexdouble_t *) w, NULL, &n, (linalg_complexdouble_t *) (vec ? vec->elements : NULL), &n, work, &lwork, rwork, &info); +#endif + + return (info==0 ? LINALGERR_OK : (info>0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS)); +} + +/** Low level SVD */ +static linalgError_t _svd(objectmatrix *a, double *s, objectmatrix *u, objectmatrix *vt) { + int info, m=a->nrows, n=a->ncols; + int minmn = (m < n) ? m : n; + +#ifdef MORPHO_LINALG_USE_LAPACKE + double* superb = malloc(minmn * sizeof(double)); + if (!superb) return LINALGERR_ALLOC; + info = LAPACKE_zgesvd(LAPACK_COL_MAJOR, + (u ? 'A' : 'N'), // jobu: 'A' = all U columns, 'N' = no U + (vt ? 'A' : 'N'), // jobvt: 'A' = all VT rows, 'N' = no VT + m, n, + (linalg_complexdouble_t *) a->elements, m, // input matrix A (overwritten) + s, // singular values (min(m,n)) + (linalg_complexdouble_t *) (u ? u->elements : NULL), m, // U matrix (m×m) + (linalg_complexdouble_t *) (vt ? vt->elements : NULL), n, // VT matrix (n×n) + superb + ); + free(superb); +#else + int lwork = -1; + linalg_complexdouble_t work_query; + double rwork[5 * minmn]; // rwork needs at least 5*min(m,n) for zgesvd + + // Query optimal work size + zgesvd_((u ? "A" : "N"), (vt ? "A" : "N"), &m, &n, + (linalg_complexdouble_t *) a->elements, &m, s, + (linalg_complexdouble_t *) (u ? u->elements : NULL), &m, + (linalg_complexdouble_t *) (vt ? vt->elements : NULL), &n, + &work_query, &lwork, rwork, &info); + + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); + + lwork = (int)creal(work_query); + linalg_complexdouble_t work[lwork]; + zgesvd_((u ? "A" : "N"), (vt ? "A" : "N"), &m, &n, + (linalg_complexdouble_t *) a->elements, &m, s, + (linalg_complexdouble_t *) (u ? u->elements : NULL), &m, + (linalg_complexdouble_t *) (vt ? vt->elements : NULL), &n, + work, &lwork, rwork, &info); +#endif + + return (info == 0 ? LINALGERR_OK : (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS)); +} + +/** Low level QR decomposition */ +static linalgError_t _qr(objectmatrix *a, objectmatrix *q, objectmatrix *r) { + int info, m=a->nrows, n=a->ncols; + int minmn = (m < n) ? m : n; + + if (q) { + linalg_complexdouble_t *qelems = (linalg_complexdouble_t *) q->elements; + memset(q->elements, 0, q->nels*sizeof(double)); + for (int i = 0; i < m; i++) qelems[i*m+i] = 1.0; + } + if (minmn==0) { + if (r) matrix_copy(a, r); + return LINALGERR_OK; + } + + // Compute QR factorization without pivoting: A = Q*R +#ifdef MORPHO_LINALG_USE_LAPACKE + linalg_complexdouble_t tau[minmn]; + info = LAPACKE_zgeqrf(LAPACK_COL_MAJOR, m, n, (linalg_complexdouble_t *) a->elements, m, tau); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); +#else + linalg_complexdouble_t tau[minmn]; + int lwork = -1; + int lwork_geqrf; + linalg_complexdouble_t work_query; + + // Query optimal work size for ZGEQRF + zgeqrf_(&m, &n, (linalg_complexdouble_t *) a->elements, &m, tau, &work_query, &lwork, &info); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); + + lwork_geqrf = (int) creal(work_query); + linalg_complexdouble_t work[lwork_geqrf]; + lwork = lwork_geqrf; + + // Compute QR factorization without pivoting + zgeqrf_(&m, &n, (linalg_complexdouble_t *) a->elements, &m, tau, work, &lwork, &info); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); +#endif + + // Extract R (upper triangle of a) into r + // Copy entire matrix first then zero out below the diagonal + matrix_copy(a, r); + linalg_complexdouble_t *relems = (linalg_complexdouble_t *) r->elements; + for (int j = 0; j < n && j < m - 1; j++) { + memset(&relems[j * m + (j + 1)], 0, (m - j - 1) * sizeof(linalg_complexdouble_t)); + } + + // Generate Q by applying the Householder product to the identity matrix + if (q) { +#ifdef MORPHO_LINALG_USE_LAPACKE + info = LAPACKE_zunmqr(LAPACK_COL_MAJOR, 'L', 'N', m, m, minmn, (linalg_complexdouble_t *) a->elements, m, tau, (linalg_complexdouble_t *) q->elements, m); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); +#else + int lwork_unmqr = -1; + linalg_complexdouble_t unmqr_work_query; + zunmqr_("L", "N", &m, &m, &minmn, (linalg_complexdouble_t *) a->elements, &m, tau, (linalg_complexdouble_t *) q->elements, &m, &unmqr_work_query, &lwork_unmqr, &info); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); + + lwork_unmqr = (int) creal(unmqr_work_query); + linalg_complexdouble_t unmqr_work[lwork_unmqr]; + zunmqr_("L", "N", &m, &m, &minmn, (linalg_complexdouble_t *) a->elements, &m, tau, (linalg_complexdouble_t *) q->elements, &m, unmqr_work, &lwork_unmqr, &info); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); +#endif + } + + return LINALGERR_OK; +} + +/* ---------------------- + * Interface definition + * ---------------------- */ + +matrixinterfacedefn complexmatrixdefn = { + .printelfn = _printelfn, + .printeltobufffn = _printeltobufffn, + .getelfn = _getelfn, + .setelfn = _setelfn, + .normfn = _normfn, + .solvefn = _solve, + .eigenfn = _eigen, + .svdfn = _svd, + .qrfn = _qr +}; + +/* ---------------------- + * Constructor + * ---------------------- */ + +/** Create a new complex matrix */ +objectcomplexmatrix *complexmatrix_new(MatrixIdx_t nrows, MatrixIdx_t ncols, bool zero) { + return (objectcomplexmatrix *) matrix_newwithtype(OBJECT_COMPLEXMATRIX, nrows, ncols, 2, zero); +} + +/* ---------------------- + * Element access + * ---------------------- */ + +/** Sets a matrix element. */ +linalgError_t complexmatrix_setelement(objectcomplexmatrix *matrix, MatrixIdx_t row, MatrixIdx_t col, MorphoComplex value) { + MatrixIdx_t row_idx = row, col_idx = col; + LINALG_ERRCHECKRETURN(matrix_validateindex(&row_idx, matrix->nrows)); + LINALG_ERRCHECKRETURN(matrix_validateindex(&col_idx, matrix->ncols)); + MatrixCount_t ix = matrix->nvals*(col_idx*matrix->nrows+row_idx); + matrix->elements[ix]=creal(value); + matrix->elements[ix+1]=cimag(value); + return LINALGERR_OK; +} + +/** Gets a matrix element */ +linalgError_t complexmatrix_getelement(objectcomplexmatrix *matrix, MatrixIdx_t row, MatrixIdx_t col, MorphoComplex *value) { + MatrixIdx_t row_idx = row, col_idx = col; + LINALG_ERRCHECKRETURN(matrix_validateindex(&row_idx, matrix->nrows)); + LINALG_ERRCHECKRETURN(matrix_validateindex(&col_idx, matrix->ncols)); + MatrixCount_t ix = matrix->nvals*(col_idx*matrix->nrows+row_idx); + if (value) *value=MCBuild(matrix->elements[ix],matrix->elements[ix+1]); + return LINALGERR_OK; +} + +/** Copies a real matrix x into a complex matrix y */ +static linalgError_t _stridedcopy(objectmatrix *x, objectmatrix *y, int offset) { + if (!(x->ncols==y->ncols && x->nrows==y->nrows)) return LINALGERR_INCOMPATIBLE_DIM; + + cblas_dcopy((linalg_int_t) x->ncols*x->nrows, x->elements+offset, x->nvals, y->elements, y->nvals); + return LINALGERR_OK; +} + +linalgError_t complexmatrix_promote(objectmatrix *x, objectcomplexmatrix *y) { + return _stridedcopy(x, y, 0); +} + +/** Copies the real part of a complex matrix y into */ +linalgError_t complexmatrix_demote(objectcomplexmatrix *x, objectmatrix *y, bool imag) { + return _stridedcopy(x, y, (imag?1:0)); +} + +/* ---------------------- + * Complex arithmetic + * ---------------------- */ + +/** Performs c <- alpha*(a*b) + beta*c with complex matrices */ +linalgError_t complexmatrix_mmul(MorphoComplex alpha, objectmatrix *a, objectmatrix *b, MorphoComplex beta, objectmatrix *c) { + if (!(a->ncols==b->nrows && a->nrows==c->nrows && b->ncols==c->ncols)) return LINALGERR_INCOMPATIBLE_DIM; + + cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, + a->nrows, b->ncols, a->ncols, + &alpha, (linalg_complexdouble_t *) a->elements, + a->nrows, (linalg_complexdouble_t *) b->elements, b->nrows, + &beta, (linalg_complexdouble_t *) c->elements, c->nrows); + return LINALGERR_OK; +} + +/** Scales a matrix x <- scale * x >*/ +void complexmatrix_scale(objectmatrix *a, MorphoComplex scale) { + cblas_zscal(a->nrows * a->ncols, (linalg_complexdouble_t *) &scale, (linalg_complexdouble_t *) a->elements, 1); +} + +/** Finds the Frobenius inner product of two complex matrices (a, b) = \sum_{i,j} conj(a)_ij * b_ij */ +linalgError_t complexmatrix_inner(objectcomplexmatrix *a, objectcomplexmatrix *b, MorphoComplex *out) { + if (!(a->ncols==b->ncols && a->nrows==b->nrows)) return LINALGERR_INCOMPATIBLE_DIM; + + cblas_zdotc_sub(a->nrows * a->ncols, (linalg_complexdouble_t *) a->elements, 1, + (linalg_complexdouble_t *) b->elements, 1, + (linalg_complexdouble_t *) out); + return LINALGERR_OK; +} + +/** Rank 1 update: Performs c <- alpha*a \outer b + c; a and b are treated as column vectors */ +linalgError_t complexmatrix_r1update(MorphoComplex alpha, objectcomplexmatrix *a, objectcomplexmatrix *b, objectcomplexmatrix *c) { + MatrixIdx_t m=a->nrows*a->ncols, n=b->nrows*b->ncols; + if (!(m==c->nrows && n==c->ncols)) return LINALGERR_INCOMPATIBLE_DIM; + + cblas_zgeru(CblasColMajor, m, n, (linalg_complexdouble_t *) &alpha, (linalg_complexdouble_t *) a->elements, 1, + (linalg_complexdouble_t *) b->elements, 1, + (linalg_complexdouble_t *) c->elements, c->nrows); + return LINALGERR_OK; +} + +/** Calculate the trace of a matrix */ +linalgError_t complexmatrix_trace(objectcomplexmatrix *a, MorphoComplex *out) { + if (a->nrows!=a->ncols) return LINALGERR_NOT_SQUARE; + MorphoComplex one = MCBuild(1.0, 0.0); + cblas_zdotu_sub(a->nrows, (linalg_complexdouble_t *) a->elements, a->ncols+1, (linalg_complexdouble_t *) &one, 0, (linalg_complexdouble_t *) out); + return LINALGERR_OK; +} + +/** Inverts the matrix a + * @param[in] a matrix to be inverted + * @returns linalgError_t indicating the status; MATRIX_OK indicates success. */ +linalgError_t complexmatrix_inverse(objectcomplexmatrix *a) { + int nrows=a->nrows, ncols=a->ncols, info; + int pivot[nrows]; + +#ifdef MORPHO_LINALG_USE_LAPACKE + info=LAPACKE_zgetrf(LAPACK_COL_MAJOR, nrows, ncols, (linalg_complexdouble_t *) a->elements, nrows, pivot); +#else + zgetrf_(&nrows, &ncols, (linalg_complexdouble_t *) a->elements, &nrows, pivot, &info); +#endif + if (info!=0) return (info>0 ? LINALGERR_MATRIX_SINGULAR : LINALGERR_LAPACK_INVLD_ARGS); + +#ifdef MORPHO_LINALG_USE_LAPACKE + info=LAPACKE_zgetri(LAPACK_COL_MAJOR, nrows, (linalg_complexdouble_t *) a->elements, nrows, pivot); +#else + int lwork=nrows*ncols; linalg_complexdouble_t work[nrows*ncols]; + zgetri_(&nrows, (linalg_complexdouble_t *) a->elements, &nrows, pivot, work, &lwork, &info); +#endif + + return (info==0 ? LINALGERR_OK : (info>0 ? LINALGERR_MATRIX_SINGULAR : LINALGERR_LAPACK_INVLD_ARGS)); +} + +/* ********************************************************************** + * ComplexMatrix constructors + * ********************************************************************** */ + +value complexmatrix_constructor__int_int(vm *v, int nargs, value *args) { + MatrixIdx_t nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + MatrixIdx_t ncols = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); + + LINALG_ERRCHECKVMRETURN(LINALG_VALIDATECONSTRUCTORDIMS(nrows, ncols), MORPHO_NIL); + objectcomplexmatrix *new=complexmatrix_new(nrows, ncols, true); + return morpho_wrapandbind(v, (object *) new); +} + +value complexmatrix_constructor__int(vm *v, int nargs, value *args) { + MatrixIdx_t nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + LINALG_ERRCHECKVMRETURN(LINALG_VALIDATECONSTRUCTORDIMS(nrows, 1), MORPHO_NIL); + objectcomplexmatrix *new=complexmatrix_new(nrows, 1, true); + return morpho_wrapandbind(v, (object *) new); +} + +value complematrix_constructor__matrix(vm *v, int nargs, value *args) { + objectmatrix *a = MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + + objectcomplexmatrix *new=complexmatrix_new(a->nrows, a->ncols, true); + if (new) complexmatrix_promote(a, new); + return morpho_wrapandbind(v, (object *) new); +} + +/** Constructs a complexmatrix from a list of lists or tuples */ +value complexmatrix_constructor__list(vm *v, int nargs, value *args) { + objectmatrix *new = matrix_listconstructor(v, MORPHO_GETARG(args, 0), OBJECT_COMPLEXMATRIX, 2); + return morpho_wrapandbind(v, (object *) new); +} + +/** Constructs a matrix from an array */ +value complexmatrix_constructor__array(vm *v, int nargs, value *args) { + objectarray *a = MORPHO_GETARRAY(MORPHO_GETARG(args, 0)); + if (a->ndim!=2) { morpho_runtimeerror(v, LINALG_INVLDARGS); return MORPHO_NIL; } + + objectmatrix *new = matrix_arrayconstructor(v, a, OBJECT_COMPLEXMATRIX, 2); + if (!new) return MORPHO_NIL; + return morpho_wrapandbind(v, (object *) new); +} + +/* ********************************************************************** + * ComplexMatrix veneer class + * ********************************************************************** */ + +/* ---------------------- + * Arithmetic + * ---------------------- */ + +/** Add a vector */ +static value _axpy(vm *v, int nargs, value *args, double alpha) { + objectcomplexmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + value out=MORPHO_NIL; + + if (a->ncols==b->ncols && a->nrows==b->nrows) { + objectcomplexmatrix *new=complexmatrix_new(a->nrows, a->ncols, true); + if (new) { + complexmatrix_promote(b, new); + matrix_axpy(alpha, a, new); + } + out = morpho_wrapandbind(v, (object *) new); + } else morpho_runtimeerror(v, LINALG_INCOMPATIBLEMATRICES); + return out; +} + +value ComplexMatrix_add__matrix(vm *v, int nargs, value *args) { + return _axpy(v, nargs, args, 1.0); +} + +value ComplexMatrix_sub__matrix(vm *v, int nargs, value *args) { + value out = _axpy(v, nargs, args, -1.0); + if (matrix_isamatrix(out)) matrix_scale(MORPHO_GETMATRIX(out), -1.0); // -(-A + B) + return out; +} + +value ComplexMatrix_subr__matrix(vm *v, int nargs, value *args) { + return _axpy(v, nargs, args, -1.0); +} + +value ComplexMatrix_mul__complex(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + + objectmatrix *new = matrix_clone(a); + if (new) complexmatrix_scale(new, MORPHO_GETCOMPLEX(MORPHO_GETARG(args, 0))->Z); + return morpho_wrapandbind(v, (object *) new); +} + +/** Multiplication by a complexmatrix or a regular matrix */ +static bool _promote(vm *v, objectmatrix *b, objectmatrix **bp) { // Promotes b to a complexmatrix + *bp=complexmatrix_new(b->nrows, b->ncols, true); + if (!*bp) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return false; } + return complexmatrix_promote(b, *bp)==LINALGERR_OK; +} + +static value _axb(vm *v, objectmatrix *a, objectmatrix *b) { // Performs a*b returning a wrapped value + if (a->ncols!=b->nrows) { morpho_runtimeerror(v, LINALG_INCOMPATIBLEMATRICES); return MORPHO_NIL; } + objectcomplexmatrix *new=complexmatrix_new(a->nrows, b->ncols, false); + if (!new) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return MORPHO_NIL; } + complexmatrix_mmul(MCBuild(1.0, 0.0), a, b, MCBuild(0.0, 0.0), new); + return morpho_wrapandbind(v, (object *) new); +} + +static value _mul(vm *v, value a, value b, bool promoteb, bool swap) { // Driver routine for a*b + objectmatrix *A=MORPHO_GETMATRIX(a), *B=MORPHO_GETMATRIX(b), *bp=NULL; + if (promoteb) { if (_promote(v, B, &bp)) { B=bp; } else { return MORPHO_NIL; } } // Promote b if requested + value out = (swap ? _axb(v, B, A) : _axb(v, A, B)); // Multiply, swapping arguments if requested + if (bp) object_free((object *) bp); + return out; +} + +value ComplexMatrix_mul__complexmatrix(vm *v, int nargs, value *args) { + return _mul(v, MORPHO_SELF(args), MORPHO_GETARG(args, 0), false, false); +} + +value ComplexMatrix_mul__matrix(vm *v, int nargs, value *args) { + return _mul(v, MORPHO_SELF(args), MORPHO_GETARG(args, 0), true, false); +} + +value ComplexMatrix_mulr__matrix(vm *v, int nargs, value *args) { + return _mul(v, MORPHO_SELF(args), MORPHO_GETARG(args, 0), true, true); +} + +value ComplexMatrix_div__matrix(vm *v, int nargs, value *args) { + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_SELF(args)), *A=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)), *ap=NULL; + objectmatrix *new=matrix_clone(b); + + if (!new) return morpho_wrapandbind(v, NULL); + if (!_promote(v, A, &ap)) goto ComplexMatrix_div__matrix_cleanup; + + LINALG_ERRCHECKVMGOTO(matrix_solve(ap, new), ComplexMatrix_div__matrix_cleanup); + + object_free((object *) ap); + return morpho_wrapandbind(v, (object *) new); + +ComplexMatrix_div__matrix_cleanup: + if (new) object_free((object *) new); + if (ap) object_free((object *) ap); + return MORPHO_NIL; +} + +value ComplexMatrix_divr__matrix(vm *v, int nargs, value *args) { + objectmatrix *A=MORPHO_GETMATRIX(MORPHO_SELF(args)), *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)), *bp=NULL; + + if (!_promote(v, b, &bp)) goto ComplexMatrix_divr__matrix_cleanup; + LINALG_ERRCHECKVMGOTO(matrix_solve(A, bp), ComplexMatrix_divr__matrix_cleanup); + + return morpho_wrapandbind(v, (object *) bp); + +ComplexMatrix_divr__matrix_cleanup: + if (bp) object_free((object *) bp); + return MORPHO_NIL; +} + +/** Computes the trace */ +value ComplexMatrix_trace(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + MorphoComplex tr=MCBuild(0,0); + LINALG_ERRCHECKVM(complexmatrix_trace(a, &tr)); + objectcomplex *new = object_newcomplex(creal(tr), cimag(tr)); + return morpho_wrapandbind(v, (object *) new); +} + +/** Inverts a matrix */ +value ComplexMatrix_inverse(vm *v, int nargs, value *args) { + objectcomplexmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + objectcomplexmatrix *new = matrix_clone(a); + out = morpho_wrapandbind(v, (object *) new); + if (new) LINALG_ERRCHECKVM(complexmatrix_inverse(new)); + + return out; +} + +static value _realimag(vm *v, int nargs, value *args, bool imag) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *new=matrix_new(a->nrows, a->ncols, false); + if (new) complexmatrix_demote(a, new, imag); + return morpho_wrapandbind(v, (object *) new); +} + +/** Extract real part */ +value ComplexMatrix_real(vm *v, int nargs, value *args) { + return _realimag(v, nargs, args, false); +} + +/** Extract imaginary part */ +value ComplexMatrix_imag(vm *v, int nargs, value *args) { + return _realimag(v, nargs, args, true); +} + +static value _conj(vm *v, int nargs, value *args, bool trans) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *new=matrix_clone(a); + if (new) { + if (trans) matrix_transpose(a, new); + cblas_dscal(a->nrows*a->ncols, -1.0, new->elements+1, new->nvals); + } + return morpho_wrapandbind(v, (object *) new); +} + +/** Extract imaginary part */ +value ComplexMatrix_conj(vm *v, int nargs, value *args) { + return _conj(v, nargs, args, false); +} + +/** Return conjugate transpose */ +value ComplexMatrix_conjTranspose(vm *v, int nargs, value *args) { + return _conj(v, nargs, args, true); +} + +/* --------- + * Products + * --------- */ + +/** Frobenius inner product */ +value ComplexMatrix_inner(vm *v, int nargs, value *args) { + objectcomplexmatrix *a=MORPHO_GETCOMPLEXMATRIX(MORPHO_SELF(args)), *b = NULL; + MorphoComplex prod=MCBuild(0.0, 0.0); + value arg = MORPHO_GETARG(args, 0), out = MORPHO_NIL; + objectmatrix *bp = NULL; + + if (MORPHO_ISCOMPLEXMATRIX(arg)) { + b=MORPHO_GETCOMPLEXMATRIX(arg); + } else if (_promote(v, MORPHO_GETMATRIX(arg), &bp)) { + b=bp; + } else goto ComplexMatrix_inner_cleanup; + + if (complexmatrix_inner(a, b, &prod)==LINALGERR_OK) { + objectcomplex *new = object_newcomplex(creal(prod), cimag(prod)); + out = morpho_wrapandbind(v, (object *) new); + } else morpho_runtimeerror(v, LINALG_INCOMPATIBLEMATRICES); + +ComplexMatrix_inner_cleanup: + if (bp) object_free((object *) bp); + return out; +} + +/** Outer product */ +value ComplexMatrix_outer(vm *v, int nargs, value *args) { + objectcomplexmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectcomplexmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + + objectcomplexmatrix *new=complexmatrix_new(a->nrows*a->ncols, b->nrows*b->ncols, true); + if (new) LINALG_ERRCHECKVM(complexmatrix_r1update(MCBuild(1.0,0.0), a, b, new)); + + return morpho_wrapandbind(v, (object *) new); +} + +MORPHO_BEGINCLASS(ComplexMatrix) +MORPHO_METHOD_SIGNATURE(MORPHO_PRINT_METHOD, "()", Matrix_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_FORMAT_METHOD, "(String)", Matrix_format, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ASSIGN_METHOD, "(ComplexMatrix)", Matrix_assign, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_CLONE_METHOD, "ComplexMatrix ()", Matrix_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "Complex (Int)", Matrix_enumerate, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "ComplexMatrix (Range)", Matrix_index__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "ComplexMatrix (List)", Matrix_index__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "ComplexMatrix (Tuple)", Matrix_index__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "Complex (Int, Int)", Matrix_index__int_int, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "ComplexMatrix (_,_)", Matrix_index__x_x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "ComplexMatrix (...)", Matrix_index__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_SETINDEX_METHOD, "(Int,_)", Matrix_setindex__int_x, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MORPHO_SETINDEX_METHOD, "(Int,Int,_)", Matrix_setindex__int_int_x, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MORPHO_SETINDEX_METHOD, "(_,_,ComplexMatrix)", Matrix_setindex__x_x_matrix, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MATRIX_GETCOLUMN_METHOD, "ComplexMatrix (Int)", Matrix_getcolumn__int, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_SETCOLUMN_METHOD, "(Int, ComplexMatrix)", Matrix_setcolumn__int_matrix, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "ComplexMatrix (ComplexMatrix)", Matrix_add__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "ComplexMatrix (Matrix)", ComplexMatrix_add__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "ComplexMatrix (_)", Matrix_add__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "ComplexMatrix (Nil)", Matrix_add__nil, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_ADDR_METHOD, "ComplexMatrix (Matrix)", ComplexMatrix_add__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ADDR_METHOD, "ComplexMatrix (_)", Matrix_add__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ADDR_METHOD, "ComplexMatrix (Nil)", Matrix_add__nil, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "ComplexMatrix (ComplexMatrix)", Matrix_sub__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "ComplexMatrix (Matrix)", ComplexMatrix_sub__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "ComplexMatrix (Nil)", Matrix_add__nil, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "ComplexMatrix (_)", Matrix_sub__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_SUBR_METHOD, "ComplexMatrix (_)", Matrix_subr__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_SUBR_METHOD, "ComplexMatrix (Matrix)", ComplexMatrix_subr__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_MUL_METHOD, "ComplexMatrix (_)", Matrix_mul__float, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_MUL_METHOD, "ComplexMatrix (Complex)", ComplexMatrix_mul__complex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_MUL_METHOD, "ComplexMatrix (ComplexMatrix)", ComplexMatrix_mul__complexmatrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_MUL_METHOD, "ComplexMatrix (Matrix)", ComplexMatrix_mul__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_MULR_METHOD, "ComplexMatrix (Matrix)", ComplexMatrix_mulr__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_MULR_METHOD, "ComplexMatrix (Complex)", ComplexMatrix_mul__complex, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_MULR_METHOD, "ComplexMatrix (_)", Matrix_mul__float, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_DIV_METHOD, "ComplexMatrix (_)", Matrix_div__float, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_DIV_METHOD, "ComplexMatrix (Matrix)", ComplexMatrix_div__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_DIV_METHOD, "ComplexMatrix (ComplexMatrix)", Matrix_div__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_DIVR_METHOD, "ComplexMatrix (Matrix)", ComplexMatrix_divr__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ACC_METHOD, "(_, ComplexMatrix)", Matrix_acc__x_x_matrix, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MATRIX_INVERSE_METHOD, "ComplexMatrix ()", ComplexMatrix_inverse, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_NORM_METHOD, "Float (_)", Matrix_norm__x, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_NORM_METHOD, "Float ()", Matrix_norm, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_SUM_METHOD, "Complex ()", Matrix_sum, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD_SIGNATURE(MATRIX_TRACE_METHOD, "Complex ()", ComplexMatrix_trace, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_TRANSPOSE_METHOD, "ComplexMatrix ()", Matrix_transpose, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(COMPLEX_REAL_METHOD, "Matrix ()", ComplexMatrix_real, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(COMPLEX_IMAG_METHOD, "Matrix ()", ComplexMatrix_imag, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(COMPLEX_CONJUGATE_METHOD, "ComplexMatrix ()", ComplexMatrix_conj, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(COMPLEXMATRIX_CONJTRANSPOSE_METHOD, "ComplexMatrix ()", ComplexMatrix_conjTranspose, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_INNER_METHOD, "Complex (ComplexMatrix)", ComplexMatrix_inner, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_INNER_METHOD, "Complex (Matrix)", ComplexMatrix_inner, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_OUTER_METHOD, "ComplexMatrix (ComplexMatrix)", ComplexMatrix_outer, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_EIGENVALUES_METHOD, "Tuple ()", Matrix_eigenvalues, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_EIGENSYSTEM_METHOD, "Tuple ()", Matrix_eigensystem, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_SVD_METHOD, "Tuple ()", Matrix_svd, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_QR_METHOD, "Tuple ()", Matrix_qr, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_RESHAPE_METHOD, "(Int,Int)", Matrix_reshape, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MATRIX_ROLL_METHOD, "ComplexMatrix (Int)", Matrix_roll__int, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_ROLL_METHOD, "ComplexMatrix (Int,Int)", Matrix_roll__int_int, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ENUMERATE_METHOD, "(Int)", Matrix_enumerate, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_COUNT_METHOD, "Int ()", Matrix_count, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MATRIX_DIMENSIONS_METHOD, "Tuple ()", Matrix_dimensions, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS) +MORPHO_ENDCLASS + +/* ********************************************************************** + * Initialization + * ********************************************************************** */ + +void complexmatrix_initialize(void) { + objectcomplexmatrixtype=object_addtype(&objectmatrixdefn); + matrix_addinterface(&complexmatrixdefn); + + objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); + value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + + value complexmatrixclass=builtin_addclass(COMPLEXMATRIX_CLASSNAME, MORPHO_GETCLASSDEFINITION(ComplexMatrix), objclass); + object_setveneerclass(OBJECT_COMPLEXMATRIX, complexmatrixclass); + + morpho_addfunction(COMPLEXMATRIX_CLASSNAME, "ComplexMatrix (Int, Int)", complexmatrix_constructor__int_int, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(COMPLEXMATRIX_CLASSNAME, "ComplexMatrix (Int)", complexmatrix_constructor__int, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(COMPLEXMATRIX_CLASSNAME, "ComplexMatrix (ComplexMatrix)", matrix_constructor__matrix, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(COMPLEXMATRIX_CLASSNAME, "ComplexMatrix (Matrix)", complematrix_constructor__matrix, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(COMPLEXMATRIX_CLASSNAME, "ComplexMatrix (List)", complexmatrix_constructor__list, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(COMPLEXMATRIX_CLASSNAME, "ComplexMatrix (Tuple)", complexmatrix_constructor__list, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(COMPLEXMATRIX_CLASSNAME, "ComplexMatrix (Array)", complexmatrix_constructor__array, MORPHO_FN_CONSTRUCTOR, NULL); +} diff --git a/src/linalg/complexmatrix.h b/src/linalg/complexmatrix.h new file mode 100644 index 000000000..6e89b7529 --- /dev/null +++ b/src/linalg/complexmatrix.h @@ -0,0 +1,33 @@ +/** @file complexmatrix.h + * @author T J Atherton + * + * @brief New linear algebra library +*/ + +#ifndef complexmatrix_h +#define complexmatrix_h + +#include "matrix.h" + +/* ------------------------------------------------------- + * ComplexMatrix veneer class + * ------------------------------------------------------- */ + +#define COMPLEXMATRIX_CLASSNAME "ComplexMatrix" + +#define COMPLEXMATRIX_CONJTRANSPOSE_METHOD "conjTranspose" + +extern objecttype objectcomplexmatrixtype; +#define OBJECT_COMPLEXMATRIX objectcomplexmatrixtype + +typedef objectmatrix objectcomplexmatrix; + +/** Tests whether an object is a complex matrix */ +#define MORPHO_ISCOMPLEXMATRIX(val) object_istype(val, OBJECT_COMPLEXMATRIX) + +/** Gets the object as a complex matrix */ +#define MORPHO_GETCOMPLEXMATRIX(val) ((objectcomplexmatrix *) MORPHO_GETOBJECT(val)) + +void complexmatrix_initialize(void); + +#endif diff --git a/src/linalg/linalg.c b/src/linalg/linalg.c new file mode 100644 index 000000000..ac8893a1e --- /dev/null +++ b/src/linalg/linalg.c @@ -0,0 +1,49 @@ +/** @file linalg.c + * @author T J Atherton + * + * @brief Improved linear algebra library +*/ + +#include "linalg.h" + +/* ------------------------------------------------------- + * Errors + * ------------------------------------------------------- */ + +void linalg_raiseerror(vm *v, linalgError_t err) { + switch (err) { + case LINALGERR_OK: break; + case LINALGERR_INCOMPATIBLE_DIM: morpho_runtimeerror(v, LINALG_INCOMPATIBLEMATRICES); break; + case LINALGERR_INDX_OUT_OF_BNDS: morpho_runtimeerror(v, LINALG_INDICESOUTSIDEBOUNDS); break; + case LINALGERR_MATRIX_SINGULAR: morpho_runtimeerror(v, LINALG_SINGULAR); break; + case LINALGERR_NOT_SQUARE: morpho_runtimeerror(v, LINALG_NOTSQ); break; + case LINALGERR_LAPACK_INVLD_ARGS: morpho_runtimeerror(v, LINALG_LAPACK_ARGS); break; + case LINALGERR_OP_FAILED: morpho_runtimeerror(v, LINALG_OPFAILED); break; + case LINALGERR_NOT_SUPPORTED: morpho_runtimeerror(v, LINALG_NOTSUPPORTED); break; + case LINALGERR_NON_NUMERICAL: morpho_runtimeerror(v, LINALG_NNNMRCL_ARG); break; + case LINALGERR_INVLD_ARG: morpho_runtimeerror(v, LINALG_INVLDARGS); break; + case LINALGERR_ALLOC: morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); break; + } +} + +/* ------------------------------------------------------- + * Initialization and finalization + * ------------------------------------------------------- */ + +void linalg_initialize(void) { + matrix_initialize(); + + morpho_defineerror(LINALG_INCOMPATIBLEMATRICES, ERROR_HALT, LINALG_INCOMPATIBLEMATRICES_MSG); + morpho_defineerror(LINALG_INDICESOUTSIDEBOUNDS, ERROR_HALT, LINALG_INDICESOUTSIDEBOUNDS_MSG); + morpho_defineerror(LINALG_SINGULAR, ERROR_HALT, LINALG_SINGULAR_MSG); + morpho_defineerror(LINALG_NOTSQ, ERROR_HALT, LINALG_NOTSQ_MSG); + morpho_defineerror(LINALG_LAPACK_ARGS, ERROR_HALT, LINALG_LAPACK_ARGS_MSG); + morpho_defineerror(LINALG_OPFAILED, ERROR_HALT, LINALG_OPFAILED_MSG); + morpho_defineerror(LINALG_NOTSUPPORTED, ERROR_HALT, LINALG_NOTSUPPORTED_MSG); + morpho_defineerror(LINALG_INVLDARGS, ERROR_HALT, LINALG_INVLDARGS_MSG); + morpho_defineerror(LINALG_NNNMRCL_ARG, ERROR_HALT, LINALG_NNNMRCL_ARG_MSG); + morpho_defineerror(LINALG_NORMARGS, ERROR_HALT, LINALG_NORMARGS_MSG); + morpho_defineerror(LINALG_ARITHARGS, ERROR_HALT, LINALG_ARITHARGS_MSG); + morpho_defineerror(LINALG_INVLDINDICES, ERROR_HALT, LINALG_INVLDINDICES_MSG); +} + diff --git a/src/linalg/linalg.h b/src/linalg/linalg.h new file mode 100644 index 000000000..6f021e147 --- /dev/null +++ b/src/linalg/linalg.h @@ -0,0 +1,109 @@ + +/** @file linalg.h + * @author T J Atherton + * + * @brief Improved linear algebra library +*/ + +#ifndef linalg_h +#define linalg_h + +#include "morpho.h" + +/* ------------------------------------------------------- + * objectmatrixerror type + * ------------------------------------------------------- */ + +typedef enum { + LINALGERR_OK, // Operation performed correctly + LINALGERR_INCOMPATIBLE_DIM, // Matrices have incompatible dimensions, e.g. for multiplication + LINALGERR_INDX_OUT_OF_BNDS, // Index out of bounds, e.g. for access. + LINALGERR_MATRIX_SINGULAR, // Matrix is singular + LINALGERR_NOT_SQUARE, // Matrix is required to be square for this algorithm + LINALGERR_LAPACK_INVLD_ARGS, // Invalid arguments to LAPACK routine + LINALGERR_OP_FAILED, // Matrix operation failed + LINALGERR_NOT_SUPPORTED, // Operation not supported for this matrix type + LINALGERR_NON_NUMERICAL, // Non numerical args supplied + LINALGERR_INVLD_ARG, // Invalid argument supplied + LINALGERR_ALLOC // Memory allocation failed +} linalgError_t; + +/* ------------------------------------------------------- + * Errors + * ------------------------------------------------------- */ + +#define LINALG_INCOMPATIBLEMATRICES "LnAlgMtrxIncmptbl" +#define LINALG_INCOMPATIBLEMATRICES_MSG "Matrices have incompatible shape." + +#define LINALG_INDICESOUTSIDEBOUNDS "LnAlgMtrxIndxBnds" +#define LINALG_INDICESOUTSIDEBOUNDS_MSG "Matrix index out of bounds." + +#define LINALG_SINGULAR "LnAlgMtrxSnglr" +#define LINALG_SINGULAR_MSG "Matrix is singular." + +#define LINALG_NOTSQ "LnAlgMtrxNtSq" +#define LINALG_NOTSQ_MSG "Matrix is not square." + +#define LINALG_LAPACK_ARGS "LnAlgLapackArgs" +#define LINALG_LAPACK_ARGS_MSG "Lapack function called with invalid arguments." + +#define LINALG_OPFAILED "LnAlgMtrxOpFld" +#define LINALG_OPFAILED_MSG "Matrix operation failed." + +#define LINALG_NOTSUPPORTED "LnAlgMtrxNtSpprtd" +#define LINALG_NOTSUPPORTED_MSG "Operation not supported for this matrix type." + +#define LINALG_INVLDARGS "LnAlgMtrxInvldArg" +#define LINALG_INVLDARGS_MSG "Invalid arguments to matrix method." + +#define LINALG_NNNMRCL_ARG "LnAlgMtrxNnNmrclArg" +#define LINALG_NNNMRCL_ARG_MSG "Matrix method requires numerical arguments." + +#define LINALG_NORMARGS "LnAlgMtrxNrmArgs" +#define LINALG_NORMARGS_MSG "Method 'norm' requires a supported argument: 1 or inf." + +#define LINALG_ARITHARGS "LnAlgInvldArg" +#define LINALG_ARITHARGS_MSG "Matrix arithmetic methods expect a matrix or number as their argument." + +#define LINALG_INVLDINDICES "LnAlgInvldIndx" +#define LINALG_INVLDINDICES_MSG "Matrices require two arguments for indexing." + +/* ------------------------------------------------------- + * Interface + * ------------------------------------------------------- */ + +void linalg_raiseerror(vm *v, linalgError_t err); + +/** Macros to simplify error checking: + - evaluates expression f that returns linalgError_t; + - if an error occurred, raises the corresponding error in a vm called v */ +#define LINALG_ERRCHECKVM(f) { linalgError_t err = f; if (err!=LINALGERR_OK) linalg_raiseerror(v, err); } + +/** As for LINALG_ERRCHECKVM but additionally jumps to a given label */ +#define LINALG_ERRCHECKVMGOTO(f, label) { linalgError_t err = f; if (err!=LINALGERR_OK) { linalg_raiseerror(v, err); goto label; }} + +/** As for LINALG_ERRCHECKVM but additionally returnsl */ +#define LINALG_ERRCHECKVMRETURN(f, ret) { linalgError_t err = f; if (err!=LINALGERR_OK) { linalg_raiseerror(v, err); return ret; }} + +/** Similar to the above, except returns the error rather than raising it */ +#define LINALG_ERRCHECKRETURN(f) { linalgError_t err = f; if (err!=LINALGERR_OK) return err; } + +/** Validate constructor dimensions before allocation */ +#define LINALG_VALIDATECONSTRUCTORDIMS(nrows, ncols) (((nrows)<0 || (ncols)<0) ? LINALGERR_INVLD_ARG : LINALGERR_OK) + +/* ------------------------------------------------------- + * Include the rest of the library + * ------------------------------------------------------- */ + +#ifdef MORPHO_INCLUDE_LINALG +#include "matrix.h" +#include "complexmatrix.h" +#endif + +/* ------------------------------------------------------- + * Initialization and finalization + * ------------------------------------------------------- */ + +void linalg_initialize(void); + +#endif /* linalg_h */ diff --git a/src/linalg/matrix.c b/src/linalg/matrix.c index a73c9b96e..d38d196c7 100644 --- a/src/linalg/matrix.c +++ b/src/linalg/matrix.c @@ -1,8 +1,8 @@ /** @file matrix.c * @author T J Atherton * - * @brief Veneer class over the objectmatrix type that interfaces with blas and lapack - */ + * @brief New matrices +*/ #include "build.h" #ifdef MORPHO_INCLUDE_LINALG @@ -15,21 +15,56 @@ #include "sparse.h" #include "format.h" +/* ********************************************************************** + * Matrix interface definitions + * ********************************************************************** */ + +/** Hold the matrix interface definitions as they're created */ +static matrixinterfacedefn _matrixdefn[LINALG_MAXMATRIXDEFNS]; +objecttype matrixinterfacedefnnext=0; /** Type of the next object definition */ + +void matrix_addinterface(matrixinterfacedefn *defn) { + if (matrixinterfacedefnnexttype-OBJECT_MATRIX; + return iindx>=0 && iindxSIZE_MAX/a) return true; + *out = a*b; + return false; +} + /* ********************************************************************** * Matrix objects * ********************************************************************** */ objecttype objectmatrixtype; -/** Function object definitions */ +/** Matrix object definitions */ size_t objectmatrix_sizefn(object *obj) { - return sizeof(objectmatrix)+sizeof(double) * - ((objectmatrix *) obj)->ncols * - ((objectmatrix *) obj)->nrows; + return sizeof(objectmatrix)+sizeof(double) * ((objectmatrix *) obj)->nels; } void objectmatrix_printfn(object *obj, void *v) { - morpho_printf(v, ""); + objectclass *klass=object_getveneerclass(obj->type); + morpho_printf(v, "<"); + morpho_printvalue(v, klass->name); + morpho_printf(v, ">"); } objecttypedefn objectmatrixdefn = { @@ -41,253 +76,397 @@ objecttypedefn objectmatrixdefn = { .cmpfn=NULL }; -/** Creates a matrix object */ -objectmatrix *object_newmatrix(unsigned int nrows, unsigned int ncols, bool zero) { - unsigned int nel = nrows*ncols; - objectmatrix *new = (objectmatrix *) object_new(sizeof(objectmatrix)+nel*sizeof(double), OBJECT_MATRIX); - - if (new) { - new->ncols=ncols; - new->nrows=nrows; - new->elements=new->matrixdata; - if (zero) { - memset(new->elements, 0, sizeof(double)*nel); - } - } - - return new; -} - /* ********************************************************************** - * Other constructors + * Matrix utility functions * ********************************************************************** */ -/* - * Create matrices from array objects - */ - -void matrix_raiseerror(vm *v, objectmatrixerror err) { - switch(err) { - case MATRIX_OK: break; - case MATRIX_INCMPTBLDIM: morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); break; - case MATRIX_SING: morpho_runtimeerror(v, MATRIX_SINGULAR); break; - case MATRIX_INVLD: morpho_runtimeerror(v, MATRIX_INVLDARRAYINIT); break; - case MATRIX_BNDS: morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); break; - case MATRIX_NSQ: morpho_runtimeerror(v, MATRIX_NOTSQ); break; - case MATRIX_FAILED: morpho_runtimeerror(v, MATRIX_OPFAILED); break; - case MATRIX_ALLOC: morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); break; - } +/* ---------------------- + * Matrix interface + * ---------------------- */ + +static void _printelfn(vm *v, double *el) { + double val=*el; + morpho_printf(v, "%g", (fabs(val)ndim; n++) { - int k=MORPHO_GETINTEGERVALUE(array->data[n]); - if (k>dim[n]) dim[n]=k; +/** Convert matrix_norm_t to a character for use with lapack routines */ +char matrix_normtolapack(matrix_norm_t norm) { + switch (norm) { + case MATRIX_NORM_MAX: return 'M'; + case MATRIX_NORM_L1: return '1'; + case MATRIX_NORM_INF: return 'I'; + case MATRIX_NORM_FROBENIUS: return 'F'; } + return '\0'; +} + +/** Evaluate norms */ +static double _normfn(objectmatrix *a, matrix_norm_t nrm) { + char cnrm = matrix_normtolapack(nrm); +#ifdef MORPHO_LINALG_USE_LAPACKE + return LAPACKE_dlange(LAPACK_COL_MAJOR, cnrm, a->nrows, a->ncols, a->elements, a->nrows); +#else + int nrows=a->nrows, ncols=a->ncols; + double work[nrows]; + return dlange_(&cnrm, &nrows, &ncols, a->elements, &nrows, work); +#endif +} + +/** Low level linear solve */ +static linalgError_t _solve(objectmatrix *a, objectmatrix *b, int *pivot) { + int n=a->nrows, nrhs = b->ncols, info; - if (maxdimndim) return false; +#ifdef MORPHO_LINALG_USE_LAPACKE + info=LAPACKE_dgesv(LAPACK_COL_MAJOR, n, nrhs, a->elements, n, pivot, b->elements, n); +#else + dgesv_(&n, &nrhs, a->elements, &n, pivot, b->elements, &n, &info); +#endif - for (unsigned int i=array->ndim; indim+array->nelements; i++) { - if (MORPHO_ISARRAY(array->data[i])) { - if (!matrix_getarraydimensions(MORPHO_GETARRAY(array->data[i]), dim+n, maxdim-n, &m)) return false; - } - } - *ndim=n+m; + return (info==0 ? LINALGERR_OK : (info>0 ? LINALGERR_MATRIX_SINGULAR : LINALGERR_LAPACK_INVLD_ARGS)); +} + +/** Low level eigensolver */ +static linalgError_t _eigen(objectmatrix *a, MorphoComplex *w, objectmatrix *vec) { + int info, n=a->nrows; + double wr[n], wi[n]; - return true; +#ifdef MORPHO_LINALG_USE_LAPACKE + info=LAPACKE_dgeev(LAPACK_COL_MAJOR, 'N', (vec ? 'V' : 'N'), n, a->elements, n, wr, wi, NULL, n, (vec ? vec->elements : NULL), n); +#else + int lwork=4*n; double work[4*n]; + dgeev_("N", (vec ? "V" : "N"), &n, a->elements, &n, wr, wi, NULL, &n, (vec ? vec->elements : NULL), &n, work, &lwork, &info); +#endif + for (int i=0; i0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS)); } -/** Looks up an array element recursively if necessary */ -value matrix_getarrayelement(objectarray *array, unsigned int ndim, unsigned int *indx) { - unsigned int na=array->ndim; - value out; +/** Low level SVD */ +static linalgError_t _svd(objectmatrix *a, double *s, objectmatrix *u, objectmatrix *vt) { + int info, m=a->nrows, n=a->ncols; + int minmn = (m < n) ? m : n; - if (array_getelement(array, na, indx, &out)==ARRAY_OK) { - if (ndim==na) return out; - if (MORPHO_ISARRAY(out)) { - return matrix_getarrayelement(MORPHO_GETARRAY(out), ndim-na, indx+na); - } - } +#ifdef MORPHO_LINALG_USE_LAPACKE + double* superb = malloc(minmn * sizeof(double)); + if (!superb) return LINALGERR_ALLOC; + info = LAPACKE_dgesvd(LAPACK_COL_MAJOR, + (u ? 'A' : 'N'), // jobu: 'A' = all U columns, 'N' = no U + (vt ? 'A' : 'N'), // jobvt: 'A' = all VT rows, 'N' = no VT + m, n, + a->elements, m, // input matrix A (overwritten) + s, // singular values (min(m,n)) + (u ? u->elements : NULL), m, // U matrix (m×m) + (vt ? vt->elements : NULL), n, // VT matrix (n×n) + superb + ); + free(superb); +#else + int lwork = -1; + double work_query; + // Query optimal work size + dgesvd_((u ? "A" : "N"), (vt ? "A" : "N"), &m, &n, a->elements, &m, s, + (u ? u->elements : NULL), &m, (vt ? vt->elements : NULL), &n, + &work_query, &lwork, &info); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); + + lwork = (int)work_query; + double work[lwork]; + dgesvd_((u ? "A" : "N"), (vt ? "A" : "N"), &m, &n, a->elements, &m, s, + (u ? u->elements : NULL), &m, (vt ? vt->elements : NULL), &n, + work, &lwork, &info); +#endif - return MORPHO_NIL; + return (info == 0 ? LINALGERR_OK : (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS)); } -/** Creates a new array from a list of values */ -objectmatrix *object_matrixfromarray(objectarray *array) { - unsigned int dim[2]={0,1}; // The 1 is to allow for vector arrays. - unsigned int ndim=0; - objectmatrix *ret=NULL; +/** Low level QR decomposition without pivoting */ +static linalgError_t _qr(objectmatrix *a, objectmatrix *q, objectmatrix *r) { + int info, m=a->nrows, n=a->ncols; + int minmn = (m < n) ? m : n; - if (matrix_getarraydimensions(array, dim, 2, &ndim)) { - ret=object_newmatrix(dim[0], dim[1], true); + if (q) { + memset(q->elements, 0, q->nels*sizeof(double)); + for (int i=0; ielements[i*m+i]=1.0; } + if (minmn==0) { + if (r) matrix_copy(a, r); + return LINALGERR_OK; + } + + double tau[minmn]; - unsigned int indx[2]; - if (ret) for (unsigned int i=0; ielements[j*dim[0]+i]); - } else if (!MORPHO_ISNIL(f)) { - object_free((object *) ret); return NULL; - } - } +#ifdef MORPHO_LINALG_USE_LAPACKE + info = LAPACKE_dgeqrf(LAPACK_COL_MAJOR, m, n, a->elements, m, tau); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); +#else + int lwork = -1; + int lwork_geqrf; + double work_query; + + // Query optimal work size for DGEQRF + dgeqrf_(&m, &n, a->elements, &m, tau, &work_query, &lwork, &info); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); + + lwork_geqrf = (int) work_query; + double work[lwork_geqrf]; + lwork = lwork_geqrf; + + // Compute QR factorization without pivoting + dgeqrf_(&m, &n, a->elements, &m, tau, work, &lwork, &info); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); +#endif + + // Extract R (upper triangle of a) into r + // Copy entire matrix first, then zero out below the diagonal + matrix_copy(a, r); + // Only process columns where there are rows below the diagonal (j < m - 1) + for (int j = 0; j < n && j < m - 1; j++) { + memset(&r->elements[j * m + (j + 1)], 0, (m - j - 1) * sizeof(double)); + } + + // Generate Q by applying the Householder product to the identity matrix + if (q) { +#ifdef MORPHO_LINALG_USE_LAPACKE + info = LAPACKE_dormqr(LAPACK_COL_MAJOR, 'L', 'N', m, m, minmn, a->elements, m, tau, q->elements, m); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); +#else + double ormqr_work_query; + int lwork_ormqr = -1; + dormqr_("L", "N", &m, &m, &minmn, a->elements, &m, tau, q->elements, &m, &ormqr_work_query, &lwork_ormqr, &info); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); + + lwork_ormqr = (int) ormqr_work_query; + double ormqr_work[lwork_ormqr]; + dormqr_("L", "N", &m, &m, &minmn, a->elements, &m, tau, q->elements, &m, ormqr_work, &lwork_ormqr, &info); + if (info != 0) return (info > 0 ? LINALGERR_OP_FAILED : LINALGERR_LAPACK_INVLD_ARGS); +#endif } - return ret; + return LINALGERR_OK; } -/* - * Create matrices from lists - */ +/* ---------------------- + * Interface definition + * ---------------------- */ -/** Recurses into an objectlist to find the dimensions of the array and all child arrays - * @param[in] list - to search - * @param[out] dim - array of dimensions to be filled out (must be zero'd before initial call) - * @param[in] maxdim - maximum number of dimensions - * @param[out] ndim - number of dimensions of the array */ -bool matrix_getlistdimensions(objectlist *list, unsigned int dim[], unsigned int maxdim, unsigned int *ndim) { - unsigned int m=0; +matrixinterfacedefn matrixdefn = { + .printelfn = _printelfn, + .printeltobufffn = _printeltobufffn, + .getelfn = _getelfn, + .setelfn = _setelfn, + .normfn = _normfn, + .solvefn = _solve, + .eigenfn = _eigen, + .svdfn = _svd, + .qrfn = _qr +}; + +/* ---------------------- + * Constructors + * ---------------------- */ + +/** Create a generic matrix with given type and layout */ +objectmatrix *matrix_newwithtype(objecttype type, MatrixIdx_t nrows, MatrixIdx_t ncols, MatrixIdx_t nvals, bool zero) { + if (nrows<0 || ncols<0 || nvals<=0) return NULL; + size_t nentries, scalarCount; + if (_mul_overflow_size((size_t) nrows, (size_t) ncols, &nentries)) return NULL; + if (_mul_overflow_size(nentries, (size_t) nvals, &scalarCount)) return NULL; + if (scalarCount > (size_t) ((MatrixCount_t) -1) || + scalarCount > (SIZE_MAX-sizeof(objectmatrix))/sizeof(double)) return NULL; + MatrixCount_t nels = (MatrixCount_t) scalarCount; + objectmatrix *new = (objectmatrix *) object_new(sizeof(objectmatrix) + nels*sizeof(double), type); - if (maxdim==0) return false; + if (new) { + new->nrows=nrows; + new->ncols=ncols; + new->nvals=nvals; + new->nels=nels; + new->elements=new->matrixdata; + if (zero) memset(new->elements, 0, nels*sizeof(double)); + } - /* Store the length */ - if (list->val.count>dim[0]) dim[0]=list->val.count; + return new; +} + +/** Create a new real matrix */ +objectmatrix *matrix_new(MatrixIdx_t nrows, MatrixIdx_t ncols, bool zero) { + return matrix_newwithtype(OBJECT_MATRIX, nrows, ncols, 1, zero); +} + +/** Clone a matrix */ +objectmatrix *matrix_clone(objectmatrix *in) { + objectmatrix *new = matrix_newwithtype(OBJECT_GETTYPE(in), in->nrows, in->ncols, in->nvals, false); - for (unsigned int i=0; ival.count; i++) { - if (MORPHO_ISLIST(list->val.data[i]) && maxdim>0) { - matrix_getlistdimensions(MORPHO_GETLIST(list->val.data[i]), dim+1, maxdim-1, &m); - } + if (new) cblas_dcopy((linalg_int_t) in->nels, in->elements, 1, new->elements, 1); + return new; +} + +static bool _getelement(value v, int i, value *out) { + if (MORPHO_ISLIST(v)) { + return list_getelement(MORPHO_GETLIST(v), i, out); + } else if (MORPHO_ISTUPLE(v)) { + return tuple_getelement(MORPHO_GETTUPLE(v), i, out); + } else if (MORPHO_ISNUMBER(v) || MORPHO_ISCOMPLEX(v)) { + if (i==0) { *out = v; return true; } } - *ndim=m+1; - - return true; + return false; } -/** Gets a matrix element from a (potentially nested) list. */ -bool matrix_getlistelement(objectlist *list, unsigned int ndim, unsigned int *indx, value *val) { - value out=MORPHO_NIL; - objectlist *l=list; - for (unsigned int i=0; ival.count) { - out=l->val.data[indx[i]]; - if (incols) ncols=rlen; + } else return NULL; } - if (ndim>2) return false; - - unsigned int indx[2]; - if (ret) for (unsigned int i=0; ielements[j*dim[0]+i]); - } else { - object_free((object *) ret); - return NULL; + objectmatrix *new=matrix_newwithtype(type, nrows, ncols, nvals, true); + if (!new) return NULL; + + for (int i=0; isetelfn(v, jel, new->elements+(j*nrows + i)*new->nvals)!=LINALGERR_OK) goto matrix_listconstructor_cleanup; } } } - return ret; + return new; +matrix_listconstructor_cleanup: + object_free((object *) new); + return NULL; +} + +/** Construct a matrix from an array */ +objectmatrix *matrix_arrayconstructor(vm *v, objectarray *a, objecttype type, MatrixIdx_t nvals) { + int nrows = MORPHO_GETINTEGERVALUE(a->dimensions[0]); + int ncols = MORPHO_GETINTEGERVALUE(a->dimensions[1]); + + objectmatrix *new=matrix_newwithtype(type, nrows, ncols, nvals, true); + if (!new) return NULL; + + for (int i=0; isetelfn(v, el, new->elements+(j*nrows + i)*new->nvals), + matrix_arrayconstructor_cleanup); + } + } + } + return new; +matrix_arrayconstructor_cleanup: + object_free((object *) new); + return NULL; } -/** Creates a matrix from a list of floats */ -objectmatrix *object_matrixfromfloats(unsigned int nrows, unsigned int ncols, double *list) { - objectmatrix *ret=NULL; - - ret=object_newmatrix(nrows, ncols, true); - if (ret) cblas_dcopy(ncols*nrows, list, 1, ret->elements, 1); - - return ret; +/* ---------------------- + * Accessing elements + * ---------------------- */ + + /** @brief Validates index bounds, converting negative indices to positive + * @param idx Pointer to the index, updated if valid and negative + * @param size The size of the dimension + * @returns LINALGERR_OK if conversion successful, LINALGERR_INDX_OUT_OF_BNDS if out of bounds */ +linalgError_t matrix_validateindex(MatrixIdx_t *idx, MatrixIdx_t size) { + if (*idx < 0) { + if (*idx < -size) return LINALGERR_INDX_OUT_OF_BNDS; + *idx = size + *idx; + } else if (*idx >= size) return LINALGERR_INDX_OUT_OF_BNDS; + return LINALGERR_OK; } -/* - * Clone matrices - */ +/** @brief Sets a matrix element. + @returns LINALGERR_OK if successful, LINALGERR_INDX_OUT_OF_BNDS if index out of bounds */ +linalgError_t matrix_setelement(objectmatrix *matrix, MatrixIdx_t row, MatrixIdx_t col, double value) { + MatrixIdx_t row_idx = row, col_idx = col; + LINALG_ERRCHECKRETURN(matrix_validateindex(&row_idx, matrix->nrows)); + LINALG_ERRCHECKRETURN(matrix_validateindex(&col_idx, matrix->ncols)); + matrix->elements[matrix->nvals*(col_idx*matrix->nrows+row_idx)]=value; + return LINALGERR_OK; +} -/** Clone a matrix */ -objectmatrix *object_clonematrix(objectmatrix *in) { - objectmatrix *new = object_newmatrix(in->nrows, in->ncols, false); - - if (new) { - cblas_dcopy(in->ncols * in->nrows, in->elements, 1, new->elements, 1); - } - - return new; +/** @brief Gets a matrix element + * @returns LINALGERR_OK if successful, LINALGERR_INDX_OUT_OF_BNDS if index out of bounds */ +linalgError_t matrix_getelement(objectmatrix *matrix, MatrixIdx_t row, MatrixIdx_t col, double *value) { + MatrixIdx_t row_idx = row, col_idx = col; + LINALG_ERRCHECKRETURN(matrix_validateindex(&row_idx, matrix->nrows)); + LINALG_ERRCHECKRETURN(matrix_validateindex(&col_idx, matrix->ncols)); + if (value) *value=matrix->elements[matrix->nvals*(col_idx*matrix->nrows+row_idx)]; + return LINALGERR_OK; } -/* ********************************************************************** - * Matrix operations - * ********************************************************************* */ +/** @brief Gets a pointer to a matrix element + * @returns LINALGERR_OK if successful, LINALGERR_INDX_OUT_OF_BNDS if index out of bounds */ +linalgError_t matrix_getelementptr(objectmatrix *matrix, MatrixIdx_t row, MatrixIdx_t col, double **value) { + MatrixIdx_t row_idx = row, col_idx = col; + LINALG_ERRCHECKRETURN(matrix_validateindex(&row_idx, matrix->nrows)); + LINALG_ERRCHECKRETURN(matrix_validateindex(&col_idx, matrix->ncols)); + if (value) *value=matrix->elements+matrix->nvals*(col_idx*matrix->nrows+row_idx); + return LINALGERR_OK; +} -/** @brief Sets a matrix element. - @returns true if the element is in the range of the matrix, false otherwise */ -bool matrix_setelement(objectmatrix *matrix, unsigned int row, unsigned int col, double value) { - if (colncols && rownrows) { - matrix->elements[col*matrix->nrows+row]=value; - return true; - } - return false; +/** @brief Gets a pointer to a matrix column + * @returns true if the column is in the range of the matrix, false otherwise */ +linalgError_t matrix_getcolumnptr(objectmatrix *matrix, MatrixIdx_t col, double **value) { + return matrix_getelementptr(matrix, 0, col, value); } -/** @brief Gets a matrix element - * @returns true if the element is in the range of the matrix, false otherwise */ -bool matrix_getelement(objectmatrix *matrix, unsigned int row, unsigned int col, double *value) { - if (colncols && rownrows) { - if (value) *value=matrix->elements[col*matrix->nrows+row]; - return true; - } - return false; +/** Copies the column col of matrix a into the column vector b */ +linalgError_t matrix_getcolumn(objectmatrix *a, MatrixIdx_t col, objectmatrix *b) { + MatrixIdx_t col_idx = col; + LINALG_ERRCHECKRETURN(matrix_validateindex(&col_idx, a->ncols)); + if (b->nels!=a->nrows*a->nvals) return LINALGERR_INCOMPATIBLE_DIM; + cblas_dcopy((linalg_int_t) b->nels, a->elements+a->nvals*col_idx*a->nrows, 1, b->elements, 1); + return LINALGERR_OK; } -/** @brief Gets a column's entries - * @param[in] matrix - the matrix - * @param[in] col - column number - * @param[out] v - column entries (matrix->nrows in number) - * @returns true if the element is in the range of the matrix, false otherwise */ -bool matrix_getcolumn(objectmatrix *matrix, unsigned int col, double **v) { - if (colncols) { - *v=&matrix->elements[col*matrix->nrows]; - return true; - } - return false; +/** Copies the column vector b into column col of matrix a */ +linalgError_t matrix_setcolumn(objectmatrix *a, MatrixIdx_t col, objectmatrix *b) { + MatrixIdx_t col_idx = col; + LINALG_ERRCHECKRETURN(matrix_validateindex(&col_idx, a->ncols)); + if (b->nels!=a->nrows*a->nvals) return LINALGERR_INCOMPATIBLE_DIM; + cblas_dcopy((linalg_int_t) b->nels, b->elements, 1, a->elements+a->nvals*col_idx*a->nrows, 1); + return LINALGERR_OK; } -/** @brief Sets a column's entries - * @param[in] matrix - the matrix - * @param[in] col - column number - * @param[in] v - column entries (matrix->nrows in number) - * @returns true if the element is in the range of the matrix, false otherwise */ -bool matrix_setcolumn(objectmatrix *matrix, unsigned int col, double *v) { - if (colncols) { - cblas_dcopy(matrix->nrows, v, 1, &matrix->elements[col*matrix->nrows], 1); - return true; - } - return false; +/** Copies the column vector b as a raw list of doubles into column col of matrix a */ +linalgError_t matrix_setcolumnptr(objectmatrix *a, MatrixIdx_t col, double *b) { + MatrixIdx_t col_idx = col; + LINALG_ERRCHECKRETURN(matrix_validateindex(&col_idx, a->ncols)); + cblas_dcopy((linalg_int_t) a->nrows*a->nvals, b, 1, a->elements+a->nvals*col_idx*a->nrows, 1); + return LINALGERR_OK; } /** @brief Add a vector to a column in a matrix @@ -296,1269 +475,1175 @@ bool matrix_setcolumn(objectmatrix *matrix, unsigned int col, double *v) { * @param[in] alpha - scale * @param[out] v - column entries (matrix->nrows in number) [should have m->nrows entries] * @returns true on success */ -bool matrix_addtocolumn(objectmatrix *m, unsigned int col, double alpha, double *v) { - if (colncols) { - cblas_daxpy(m->nrows, alpha, v, 1, &m->elements[col*m->nrows], 1); - return true; - } - return false; +linalgError_t matrix_addtocolumnptr(objectmatrix *a, MatrixIdx_t col, double alpha, double *b) { + if (col<0 || col>=a->ncols) return LINALGERR_INDX_OUT_OF_BNDS; + + cblas_daxpy(a->nrows*a->nvals, alpha, b, 1, a->elements+a->nvals*col*a->nrows, 1); + return LINALGERR_OK; } -/* ********************************************************************** - * Matrix arithmetic - * ********************************************************************* */ +/** Counts the number of dofs in a matrix */ +MatrixCount_t matrix_countdof(objectmatrix *a) { + return a->ncols*a->nrows*a->nvals; +} -/** Copies one matrix to another */ -unsigned int matrix_countdof(objectmatrix *a) { - return a->ncols*a->nrows; +/* ---------------------- + * Arithmetic operations + * ---------------------- */ + +/** Vector addition: Performs y <- alpha*x + y */ +linalgError_t matrix_axpy(double alpha, objectmatrix *x, objectmatrix *y) { + if (!(x->ncols==y->ncols && x->nrows==y->nrows)) return LINALGERR_INCOMPATIBLE_DIM; + + cblas_daxpy((linalg_int_t) x->nels, alpha, x->elements, 1, y->elements, 1); + return LINALGERR_OK; } -/** Copies one matrix to another */ -objectmatrixerror matrix_copy(objectmatrix *a, objectmatrix *out) { - if (a->ncols==out->ncols && a->nrows==out->nrows) { - cblas_dcopy(a->ncols * a->nrows, a->elements, 1, out->elements, 1); - return MATRIX_OK; - } - return MATRIX_INCMPTBLDIM; +/** Copies a matrix y <- x */ +linalgError_t matrix_copy(objectmatrix *x, objectmatrix *y) { + if (!(x->ncols==y->ncols && x->nrows==y->nrows)) return LINALGERR_INCOMPATIBLE_DIM; + + cblas_dcopy((linalg_int_t) x->nels, x->elements, 1, y->elements, 1); + return LINALGERR_OK; } -/** Copies a matrix to another at an arbitrary point */ -objectmatrixerror matrix_copyat(objectmatrix *a, objectmatrix *out, int row0, int col0) { - if (col0+a->ncols<=out->ncols && row0+a->nrows<=out->nrows) { - for (int j=0; jncols; j++) { - for (int i=0; inrows; i++) { - double value; - if (!matrix_getelement(a, i, j, &value)) return MATRIX_BNDS; - if (!matrix_setelement(out, row0+i, col0+j, value)) return MATRIX_BNDS; - } +/** Copies one matrix into another at an arbitrary point */ +linalgError_t matrix_copyat(objectmatrix *a, objectmatrix *out, int row0, int col0) { + if (!(col0+a->ncols<=out->ncols && row0+a->nrows<=out->nrows)) return LINALGERR_INCOMPATIBLE_DIM; + + for (int j=0; jncols; j++) { + for (int i=0; inrows; i++) { + double *src, *dest; + LINALG_ERRCHECKRETURN(matrix_getelementptr(a, i, j, &src)); + LINALG_ERRCHECKRETURN(matrix_getelementptr(out, row0+i, col0+j, &dest)); + memcpy(dest, src, sizeof(double)*a->nvals); } - - return MATRIX_OK; } - return MATRIX_INCMPTBLDIM; + return LINALGERR_OK; } -/** Performs a + b -> out. */ -objectmatrixerror matrix_add(objectmatrix *a, objectmatrix *b, objectmatrix *out) { - if (a->ncols==b->ncols && a->ncols==out->ncols && - a->nrows==b->nrows && a->nrows==out->nrows) { - if (a!=out) cblas_dcopy(a->ncols * a->nrows, a->elements, 1, out->elements, 1); - cblas_daxpy(a->ncols * a->nrows, 1.0, b->elements, 1, out->elements, 1); - return MATRIX_OK; - } - return MATRIX_INCMPTBLDIM; +/** Scales a matrix x <- scale * x >*/ +void matrix_scale(objectmatrix *x, double scale) { + cblas_dscal((linalg_int_t) x->nels, scale, x->elements, 1); } -/** Performs lambda*a + beta -> out. */ -objectmatrixerror matrix_addscalar(objectmatrix *a, double lambda, double beta, objectmatrix *out) { - if (a->ncols==out->ncols && a->nrows==out->nrows) { - for (unsigned int i=0; inrows*out->ncols; i++) { - out->elements[i]=lambda*a->elements[i]+beta; - } - return MATRIX_OK; - } +/** Loads the zero matrix a <- 0 */ +linalgError_t matrix_zero(objectmatrix *x) { + memset(x->elements, 0, sizeof(double)*x->nrows*x->ncols*x->nvals); + return LINALGERR_OK; +} - return MATRIX_INCMPTBLDIM; +/** Loads the identity matrix a <- I(n) */ +linalgError_t matrix_identity(objectmatrix *x) { + if (x->ncols!=x->nrows) return LINALGERR_NOT_SQUARE; + matrix_zero(x); + for (int i=0; inrows; i++) x->elements[x->nvals*(i+x->nrows*i)]=1.0; + return LINALGERR_OK; } -/** Performs a + lambda*b -> a. */ -objectmatrixerror matrix_accumulate(objectmatrix *a, double lambda, objectmatrix *b) { - if (a->ncols==b->ncols && a->nrows==b->nrows ) { - cblas_daxpy(a->ncols * a->nrows, lambda, b->elements, 1, a->elements, 1); - return MATRIX_OK; - } - return MATRIX_INCMPTBLDIM; +/** Performs z <- alpha*(x*y) + beta*z */ +linalgError_t matrix_mmul(double alpha, objectmatrix *x, objectmatrix *y, double beta, objectmatrix *z) { + if (!(x->ncols==y->nrows && x->nrows==z->nrows && y->ncols==z->ncols)) return LINALGERR_INCOMPATIBLE_DIM; + + cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, x->nrows, y->ncols, x->ncols, alpha, x->elements, x->nrows, y->elements, y->nrows, beta, z->elements, z->nrows); + return LINALGERR_OK; } -/** Performs a - b -> out */ -objectmatrixerror matrix_sub(objectmatrix *a, objectmatrix *b, objectmatrix *out) { - if (a->ncols==b->ncols && a->ncols==out->ncols && - a->nrows==b->nrows && a->nrows==out->nrows) { - if (a!=out) cblas_dcopy(a->ncols * a->nrows, a->elements, 1, out->elements, 1); - cblas_daxpy(a->ncols * a->nrows, -1.0, b->elements, 1, out->elements, 1); - return MATRIX_OK; - } - return MATRIX_INCMPTBLDIM; +linalgError_t matrix_mul(objectmatrix *x, objectmatrix *y, objectmatrix *z) { + return matrix_mmul(1.0, x, y, 0.0, z); } -/** Performs a * b -> out */ -objectmatrixerror matrix_mul(objectmatrix *a, objectmatrix *b, objectmatrix *out) { - if (a->ncols==b->nrows && a->nrows==out->nrows && b->ncols==out->ncols) { - cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, a->nrows, b->ncols, a->ncols, 1.0, a->elements, a->nrows, b->elements, b->nrows, 0.0, out->elements, out->nrows); - return MATRIX_OK; +/** Performs x <- alpha*x + beta */ +linalgError_t matrix_addscalar(objectmatrix *x, double alpha, double beta) { + for (MatrixCount_t i=0; incols*x->nrows; i++) { + for (int k=0; knvals; k++) { + x->elements[i*x->nvals+k]*=alpha; + if (k==0) x->elements[i*x->nvals+k]+=beta; + } } - return MATRIX_INCMPTBLDIM; + return LINALGERR_OK; } -/** Finds the Frobenius inner product of two matrices */ -objectmatrixerror matrix_inner(objectmatrix *a, objectmatrix *b, double *out) { - if (a->ncols==b->ncols && a->nrows==b->nrows) { - *out=cblas_ddot(a->ncols*a->nrows, a->elements, 1, b->elements, 1); - return MATRIX_OK; +/** Performs y <- x^T>*/ +linalgError_t matrix_transpose(objectmatrix *x, objectmatrix *y) { + if (!(x->ncols==y->nrows && x->nrows==y->ncols)) return LINALGERR_INCOMPATIBLE_DIM; + + for (MatrixCount_t i=0; incols; i++) { + for (MatrixCount_t j=0; jnrows; j++) { + for (int k=0; knvals; k++) { + y->elements[j*y->nrows*y->nvals+i*y->nvals+k] = x->elements[i*x->nrows*x->nvals+j*x->nvals+k]; + } + } } - return MATRIX_INCMPTBLDIM; + return LINALGERR_OK; } -/** Computes the outer product of two matrices */ -objectmatrixerror matrix_outer(objectmatrix *a, objectmatrix *b, objectmatrix *out) { - int m=a->nrows*a->ncols, n=b->nrows*b->ncols; - if (m==out->nrows && n==out->ncols) { - cblas_dger(CblasColMajor, m, n, 1, a->elements, 1, b->elements, 1, out->elements, out->nrows); - return MATRIX_OK; - } - return MATRIX_INCMPTBLDIM; -} - -/** Solves the system a.x = b - * @param[in] a lhs - * @param[in] b rhs - * @param[in] out - the solution x - * @param[out] lu - LU decomposition of a; you must provide an array the same size as a. - * @param[out] pivot - you must provide an array with the same number of rows as a. - * @returns objectmatrixerror indicating the status; MATRIX_OK indicates success. - * */ -static objectmatrixerror matrix_div(objectmatrix *a, objectmatrix *b, objectmatrix *out, double *lu, int *pivot) { - int n=a->nrows, nrhs = b->ncols, info; - - cblas_dcopy(a->ncols * a->nrows, a->elements, 1, lu, 1); - if (b!=out) cblas_dcopy(b->ncols * b->nrows, b->elements, 1, out->elements, 1); -#ifdef MORPHO_LINALG_USE_LAPACKE - info=LAPACKE_dgesv(LAPACK_COL_MAJOR, n, nrhs, lu, n, pivot, out->elements, n); -#else - dgesv_(&n, &nrhs, lu, &n, pivot, out->elements, &n, &info); -#endif - - return (info==0 ? MATRIX_OK : (info>0 ? MATRIX_SING : MATRIX_INVLD)); +/* ---------------------- + * Unary operations + * ---------------------- */ + +/** Computes various matrix norms */ +double matrix_norm(objectmatrix *a, matrix_norm_t norm) { + return matrix_getinterface(a)->normfn(a, norm); } -/** Solves the system a.x = b for small matrices (test with MATRIX_ISSMALL) - * @warning Uses the C stack for storage, which avoids malloc but can cause stack overflow */ -objectmatrixerror matrix_divs(objectmatrix *a, objectmatrix *b, objectmatrix *out) { - if (a->ncols==b->nrows && a->ncols == out->nrows) { - int pivot[a->nrows]; - double lu[a->nrows*a->ncols]; - - return matrix_div(a, b, out, lu, pivot); +/** Computes the sum of all elements in a matrix */ +void matrix_sum(objectmatrix *a, double *sum) { + double c[a->nvals], y, t; + for (int i=0; invals; i++) { sum[i]=0; c[i]=0; } + + for (MatrixCount_t i=0; inels; i+=a->nvals) { + for (int k=0; knvals; k++) { + y=a->elements[i+k]-c[k]; + t=sum[k]+y; + c[k]=(t-sum[k])-y; + sum[k]=t; + } } - return MATRIX_INCMPTBLDIM; } -/** Solves the system a.x = b for large matrices (test with MATRIX_ISSMALL) */ -objectmatrixerror matrix_divl(objectmatrix *a, objectmatrix *b, objectmatrix *out) { - objectmatrixerror ret = MATRIX_ALLOC; // Returned if allocation fails - if (!(a->ncols==b->nrows && a->ncols == out->nrows)) return MATRIX_INCMPTBLDIM; +/** Calculate the trace of a matrix */ +linalgError_t matrix_trace(objectmatrix *a, double *out) { + if (a->nrows!=a->ncols) return LINALGERR_NOT_SQUARE; + *out = 0.0; + for (int i = 0; i < a->nrows; i++) { + *out += a->elements[a->nvals * (i * a->nrows + i)]; + } - int *pivot=MORPHO_MALLOC(sizeof(int)*a->nrows); - double *lu=MORPHO_MALLOC(sizeof(double)*a->nrows*a->ncols); + return LINALGERR_OK; +} + +/* ---------------------- + * Binary operations + * ---------------------- */ + +/** Finds the Frobenius inner product of two matrices */ +linalgError_t matrix_inner(objectmatrix *x, objectmatrix *y, double *out) { + if (!(x->ncols==y->ncols && x->nrows==y->nrows)) return LINALGERR_INCOMPATIBLE_DIM; - if (pivot && lu) ret=matrix_div(a, b, out, lu, pivot); + *out=cblas_ddot((linalg_int_t) x->nels, x->elements, 1, y->elements, 1); + return LINALGERR_OK; +} + +/** Rank 1 update: Performs c <- alpha*a \outer b + c; a and b are treated as column vectors */ +linalgError_t matrix_r1update(double alpha, objectmatrix *a, objectmatrix *b, objectmatrix *c) { + MatrixIdx_t m=a->nrows*a->ncols, n=b->nrows*b->ncols; + if (!(m==c->nrows && n==c->ncols)) return LINALGERR_INCOMPATIBLE_DIM; + cblas_dger(CblasColMajor, m, n, alpha, a->elements, 1, b->elements, 1, c->elements, c->nrows); + return LINALGERR_OK; +} + +/** Solve the linear system a.x = b using stack allocated memory for temporary */ +linalgError_t matrix_solvesmall(objectmatrix *a, objectmatrix *b) { + int pivot[a->nrows]; + double els[a->nels]; + objectmatrix A = MORPHO_STATICMATRIX(els, a->nrows, a->ncols); + matrix_copy(a, &A); + return (matrix_getinterface(a)->solvefn) (&A, b, pivot); +} + +/** Solve the linear system a.x = b using heap allocated memory for temporary */ +linalgError_t matrix_solvelarge(objectmatrix *a, objectmatrix *b) { + int *pivot = MORPHO_MALLOC(sizeof(int)*a->nrows); + objectmatrix *A = matrix_clone(a); + linalgError_t out = LINALGERR_ALLOC; + if (pivot && A) { + out = (matrix_getinterface(a)->solvefn) (A, b, pivot); + } + if (A) object_free((object *) A); if (pivot) MORPHO_FREE(pivot); - if (lu) MORPHO_FREE(lu); - - return ret; + return out; +} + +/** Solve the linear system a.x = b; automatrically allocates storage depending on size of the matrix + * @param[in] a lhs + * @param[in|out] b rhs — overwritten by the solution + * @returns linalgError_t indicating the status; MATRIX_OK indicates success. */ +linalgError_t matrix_solve(objectmatrix *a, objectmatrix *b) { + if (a->nrows!=a->ncols) return LINALGERR_NOT_SQUARE; + if (a->nrows!=b->nrows) return LINALGERR_INCOMPATIBLE_DIM; + if (MATRIX_ISSMALL(a)) return matrix_solvesmall(a, b); + else return matrix_solvelarge(a, b); } /** Inverts the matrix a - * @param[in] a lhs - * @param[in] out - the solution x - * @returns objectmatrixerror indicating the status; MATRIX_OK indicates success. - * */ -objectmatrixerror matrix_inverse(objectmatrix *a, objectmatrix *out) { + * @param[in] a matrix to be inverted + * @returns linalgError_t indicating the status; MATRIX_OK indicates success. */ +linalgError_t matrix_inverse(objectmatrix *a) { int nrows=a->nrows, ncols=a->ncols, info; - if (!(a->ncols==out->nrows && a->ncols == out->nrows)) return MATRIX_INCMPTBLDIM; - int pivot[nrows]; - cblas_dcopy(a->ncols * a->nrows, a->elements, 1, out->elements, 1); #ifdef MORPHO_LINALG_USE_LAPACKE - info=LAPACKE_dgetrf(LAPACK_COL_MAJOR, nrows, ncols, out->elements, nrows, pivot); + info=LAPACKE_dgetrf(LAPACK_COL_MAJOR, nrows, ncols, a->elements, nrows, pivot); #else - dgetrf_(&nrows, &ncols, out->elements, &nrows, pivot, &info); + dgetrf_(&nrows, &ncols, a->elements, &nrows, pivot, &info); #endif - - if (info!=0) return (info>0 ? MATRIX_SING : MATRIX_INVLD); + if (info!=0) return (info>0 ? LINALGERR_MATRIX_SINGULAR : LINALGERR_LAPACK_INVLD_ARGS); #ifdef MORPHO_LINALG_USE_LAPACKE - info=LAPACKE_dgetri(LAPACK_COL_MAJOR, nrows, out->elements, nrows, pivot); + info=LAPACKE_dgetri(LAPACK_COL_MAJOR, nrows, a->elements, nrows, pivot); #else int lwork=nrows*ncols; double work[nrows*ncols]; - dgetri_(&nrows, out->elements, &nrows, pivot, work, &lwork, &info); + dgetri_(&nrows, a->elements, &nrows, pivot, work, &lwork, &info); #endif - return (info==0 ? MATRIX_OK : (info>0 ? MATRIX_SING : MATRIX_INVLD)); + return (info==0 ? LINALGERR_OK : (info>0 ? LINALGERR_MATRIX_SINGULAR : LINALGERR_LAPACK_INVLD_ARGS)); } -/** Compute eigenvalues and eigenvectors of a matrix - * @param[in] a - an objectmatrix to diagonalize of size n - * @param[out] wr - a buffer of size n will hold the real part of the eigenvalues on exit - * @param[out] wi - a buffer of size n will hold the imag part of the eigenvalues on exit - * @param[out] vec - (optional) will be filled out with eigenvectors as columns (should be of size n) - * @returns an error code or MATRIX_OK on success */ -objectmatrixerror matrix_eigensystem(objectmatrix *a, double *wr, double *wi, objectmatrix *vec) { - int info, n=a->nrows; - if (a->nrows!=a->ncols) return MATRIX_NSQ; - if (vec && ((a->nrows!=vec->nrows) || (a->nrows!=vec->ncols))) return MATRIX_INCMPTBLDIM; +/** Interface to eigensystem */ +linalgError_t matrix_eigen(objectmatrix *a, MorphoComplex *w, objectmatrix *vec) { + if (a->nrows!=a->ncols) return LINALGERR_NOT_SQUARE; + if (vec && ((a->nrows!=vec->nrows) || (a->nrows!=vec->ncols))) return LINALGERR_INCOMPATIBLE_DIM; - // Copy a to prevent destruction - size_t size = ((size_t) n) * ((size_t) n) * sizeof(double); - double *acopy=MORPHO_MALLOC(size); - if (!acopy) return MATRIX_ALLOC; - cblas_dcopy(n*n, a->elements, 1, acopy, 1); - -#ifdef MORPHO_LINALG_USE_LAPACKE - info=LAPACKE_dgeev(LAPACK_COL_MAJOR, 'N', (vec ? 'V' : 'N'), n, acopy, n, wr, wi, NULL, n, (vec ? vec->elements : NULL), n); -#else - int lwork=4*n; double work[4*n]; - dgeev_("N", (vec ? "V" : "N"), &n, acopy, &n, wr, wi, NULL, &n, (vec ? vec->elements : NULL), &n, work, &lwork, &info); -#endif + matrix_eigenfn_t efn = matrix_getinterface(a)->eigenfn; + if (!efn) return LINALGERR_NOT_SUPPORTED; - if (acopy) MORPHO_FREE(acopy); // Free up buffer + objectmatrix *temp = matrix_clone(a); + if (!temp) return LINALGERR_ALLOC; - if (info!=0) return (info>0 ? MATRIX_FAILED : MATRIX_INVLD); + linalgError_t result = efn(temp, w, vec); + object_free((object *) temp); - return MATRIX_OK; + return result; } +/* ---------------------- + * Display + * ---------------------- */ -/** Sums all elements of a matrix using Kahan summation */ -double matrix_sum(objectmatrix *a) { - unsigned int nel=a->ncols*a->nrows; - double sum=0.0, c=0.0, y,t; - - for (unsigned int i=0; ielements[i]-c; - t=sum+y; - c=(t-sum)-y; - sum=t; +/** Prints a matrix */ +void matrix_print(vm *v, objectmatrix *m) { + matrixinterfacedefn *intrfc=matrix_getinterface(m); + double *elptr; + for (MatrixIdx_t i=0; inrows; i++) { // Rows run from 0...m + morpho_printf(v, "[ "); + for (MatrixIdx_t j=0; jncols; j++) { // Columns run from 0...k + matrix_getelementptr(m, i, j, &elptr); + (*intrfc->printelfn) (v, elptr); + morpho_printf(v, " "); + } + morpho_printf(v, "]%s", (inrows-1 ? "\n" : "")); } - return sum; } -/** Norms */ - -/** Computes the Frobenius norm of a matrix */ -double matrix_norm(objectmatrix *a) { - double nrm2=cblas_dnrm2(a->ncols*a->nrows, a->elements, 1); - return nrm2; +/** Prints a matrix to a buffer */ +bool matrix_printtobuffer(objectmatrix *m, char *format, varray_char *out) { + matrixinterfacedefn *intrfc=matrix_getinterface(m); + double *elptr; + for (MatrixIdx_t i=0; inrows; i++) { // Rows run from 0...m + varray_charadd(out, "[ ", 2); + + for (MatrixIdx_t j=0; jncols; j++) { // Columns run from 0...k + matrix_getelementptr(m, i, j, &elptr); + if (!(*intrfc->printeltobufffn) (out, format, elptr)) return false; + varray_charadd(out, " ", 1); + } + varray_charadd(out, "]", 1); + if (inrows-1) varray_charadd(out, "\n", 1); + } + return true; } -/** Computes the L1 norm of a matrix */ -double matrix_L1norm(objectmatrix *a) { - unsigned int nel=a->ncols*a->nrows; - double sum=0.0, c=0.0, y,t; +/* ---------------------- + * Roll + * ---------------------- */ + +/** Rolls the matrix list */ +static void _rollflat(objectmatrix *a, objectmatrix *b, int nplaces) { + MatrixCount_t N=a->nrows*a->ncols*a->nvals; + MatrixCount_t n = abs(nplaces)*a->nvals; + if (n>N) n = n % N; + MatrixCount_t Np = N - n; // Number of elements to roll - for (unsigned int i=0; ielements[i])-c; - t=sum+y; - c=(t-sum)-y; - sum=t; + if (nplaces<0) { + memcpy(b->matrixdata, a->matrixdata+n, sizeof(double)*Np); + memcpy(b->matrixdata+Np, a->matrixdata, sizeof(double)*n); + } else { + memcpy(b->matrixdata+n, a->matrixdata, sizeof(double)*Np); + if (n>0) memcpy(b->matrixdata, a->matrixdata+Np, sizeof(double)*n); } - return sum; } -/** Computes the Ln norm of a matrix */ -double matrix_Lnnorm(objectmatrix *a, double n) { - unsigned int nel=a->ncols*a->nrows; - double sum=0.0, c=0.0, y,t; - - for (unsigned int i=0; ielements[i],n)-c; - t=sum+y; - c=(t-sum)-y; - sum=t; - } - return pow(sum,1.0/n); +/** Copies a arow from matrix a into brow for matrix b */ +static void _copyrow(objectmatrix *a, MatrixIdx_t arow, objectmatrix *b, MatrixIdx_t brow) { + for (MatrixIdx_t i=0; incols; i++) + memcpy(b->elements+b->nvals*(i*b->nrows+brow), a->elements+a->nvals*(i*a->nrows+arow), sizeof(double)*a->nvals); } -/** Computes the Linf norm of a matrix */ -double matrix_Linfnorm(objectmatrix *a) { - unsigned int nel=a->ncols*a->nrows; - double max=0.0; +/** Rolls a list by a number of elements along a given axis; stores the result in b */ +linalgError_t matrix_roll(objectmatrix *a, int nplaces, int axis, objectmatrix *b) { + if (!(a->nrows==b->nrows && a->ncols==b->ncols && a->nvals==b->nvals)) return LINALGERR_INCOMPATIBLE_DIM; - for (unsigned int i=0; ielements[i]); - if (y>max) max=y; + switch(axis) { + case 0: + for (int i=0; inrows; i++) { + int j = (i+nplaces); + while (j<0) j+=a->nrows; + _copyrow(a, i, b, j % a->nrows); + } + break; + case 1: _rollflat(a, b, nplaces*a->nrows); break; + default: return LINALGERR_NOT_SUPPORTED; } - return max; + + return LINALGERR_OK; } -/** Transpose a matrix */ -objectmatrixerror matrix_transpose(objectmatrix *a, objectmatrix *out) { - if (!(a->ncols==out->nrows && a->nrows == out->ncols)) return MATRIX_INCMPTBLDIM; +/* ********************************************************************** + * Matrix constructors + * ********************************************************************** */ - /* Copy elements a column at a time */ - for (unsigned int i=0; incols; i++) { - cblas_dcopy(a->nrows, a->elements+(i*a->nrows), 1, out->elements+i, a->ncols); - } - return MATRIX_OK; +value matrix_constructor__int_int(vm *v, int nargs, value *args) { + MatrixIdx_t nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)), + ncols = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); + + LINALG_ERRCHECKVMRETURN(LINALG_VALIDATECONSTRUCTORDIMS(nrows, ncols), MORPHO_NIL); + objectmatrix *new=matrix_new(nrows, ncols, true); + return morpho_wrapandbind(v, (object *) new); } -/** Calculate the trace of a matrix */ -objectmatrixerror matrix_trace(objectmatrix *a, double *out) { - if (a->nrows!=a->ncols) return MATRIX_NSQ; - *out=1.0; - *out=cblas_ddot(a->nrows, a->elements, a->ncols+1, out, 0); - - return MATRIX_OK; +value matrix_constructor__int(vm *v, int nargs, value *args) { + MatrixIdx_t nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + LINALG_ERRCHECKVMRETURN(LINALG_VALIDATECONSTRUCTORDIMS(nrows, 1), MORPHO_NIL); + objectmatrix *new=matrix_new(nrows, 1, true); + return morpho_wrapandbind(v, (object *) new); } -/** Scale a matrix */ -objectmatrixerror matrix_scale(objectmatrix *a, double scale) { - cblas_dscal(a->ncols*a->nrows, scale, a->elements, 1); - - return MATRIX_OK; +/** Clones a matrix */ +value matrix_constructor__matrix(vm *v, int nargs, value *args) { + objectmatrix *a = MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + return morpho_wrapandbind(v, (object *) matrix_clone(a)); } -/** Load the indentity matrix*/ -objectmatrixerror matrix_identity(objectmatrix *a) { - if (a->ncols!=a->nrows) return MATRIX_NSQ; - memset(a->elements, 0, sizeof(double)*a->nrows*a->ncols); - for (int i=0; inrows; i++) a->elements[i+a->nrows*i]=1.0; - return MATRIX_OK; +/** Constructs a matrix from a list of lists or tuples */ +value matrix_constructor__list(vm *v, int nargs, value *args) { + objectmatrix *new = matrix_listconstructor(v, MORPHO_GETARG(args, 0), OBJECT_MATRIX, 1); +#ifdef MORPHO_INCLUDE_SPARSE + if (!new) { + /** Could this be a concatenation operation? */ + objectsparseerror err = sparse_catmatrix(MORPHO_GETLIST(MORPHO_GETARG(args, 0)), &new); + if (err==SPARSE_INVLDINIT) { + morpho_runtimeerror(v, LINALG_INVLDARGS); + } else if (err!=SPARSE_OK) sparse_raiseerror(v, err); + } +#else + if (!new) morpho_runtimeerror(v, LINALG_INVLDARGS); +#endif + return morpho_wrapandbind(v, (object *) new); } -/** Sets a matrix to zero */ -objectmatrixerror matrix_zero(objectmatrix *a) { - memset(a->elements, 0, sizeof(double)*a->nrows*a->ncols); +/** Constructs a matrix from an array */ +value matrix_constructor__array(vm *v, int nargs, value *args) { + objectarray *a = MORPHO_GETARRAY(MORPHO_GETARG(args, 0)); + if (a->ndim!=2) { morpho_runtimeerror(v, LINALG_INVLDARGS); return MORPHO_NIL; } - return MATRIX_OK; + objectmatrix *new = matrix_arrayconstructor(v, a, OBJECT_MATRIX, 1); + if (!new) return MORPHO_NIL; + return morpho_wrapandbind(v, (object *) new); } -/** Prints a matrix */ -void matrix_print(vm *v, objectmatrix *m) { - for (int i=0; inrows; i++) { // Rows run from 0...m - morpho_printf(v, "[ "); - for (int j=0; jncols; j++) { // Columns run from 0...k - double val; - matrix_getelement(m, i, j, &val); - morpho_printf(v, "%g ", (fabs(val)nrows-1 ? "\n" : "")); - } +/** Constructs a matrix from a sparse matrix */ +value matrix_constructor__sparse(vm *v, int nargs, value *args) { + objectmatrix *new = NULL; + objectsparseerror err=sparse_tomatrix(MORPHO_GETSPARSE(MORPHO_GETARG(args, 0)), &new); + if (err!=SPARSE_OK) morpho_runtimeerror(v, LINALG_INVLDARGS); + return morpho_wrapandbind(v, (object *) new); } -/** Prints a matrix to a buffer */ -bool matrix_printtobuffer(objectmatrix *m, char *format, varray_char *out) { - for (int i=0; inrows; i++) { // Rows run from 0...m - varray_charadd(out, "[ ", 2); - - for (int j=0; jncols; j++) { // Columns run from 0...k - double val; - matrix_getelement(m, i, j, &val); - if (!format_printtobuffer(MORPHO_FLOAT(val), format, out)) return false; - varray_charadd(out, " ", 1); - } - varray_charadd(out, "]", 1); - if (inrows-1) varray_charadd(out, "\n", 1); - } - return true; +value matrix_constructor__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, MATRIX_CONSTRUCTOR); + return MORPHO_NIL; } -/** Matrix eigensystem */ -bool matrix_eigen(vm *v, objectmatrix *a, value *evals, value *evecs) { - double *ev = MORPHO_MALLOC(sizeof(double)*a->nrows*2); // Allocate temporary memory for eigenvalues - double *er=ev, *ei=ev+a->nrows; +/** Creates an identity matrix */ +value matrix_identityconstructor(vm *v, int nargs, value *args) { + if (nargs!=1) { morpho_runtimeerror(v, MATRIX_IDENTCONSTRUCTOR); return MORPHO_NIL; } - objectmatrix *vecs=NULL; // A new matrix for eigenvectors - objectlist *vallist = object_newlist(0, NULL); // List to hold eigenvalues - bool success=false; - - if (evecs) vecs=object_clonematrix(a); // Clones a to hold eigenvectors - - // Check that everything was allocated correctly - if (!(ev && vallist && (!evecs || vecs))) { - morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); goto matrix_eigen_cleanup; }; - - objectmatrixerror err=matrix_eigensystem(a, er, ei, vecs); - - if (err!=MATRIX_OK) { - matrix_raiseerror(v, err); - goto matrix_eigen_cleanup; - } - - // Now process the eigenvalues - for (int i=0; inrows; i++) { - if (fabs(ei[i])val.count; i++) { - if (MORPHO_ISOBJECT(vallist->val.data[i])) object_free(MORPHO_GETOBJECT(vallist->val.data[i])); - } - object_free((object *) vallist); - } - if (vecs) object_free((object *) vecs); - } + MatrixIdx_t n = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + objectmatrix *new = matrix_new(n,n,false); + if (new) matrix_identity(new); - return success; + return morpho_wrapandbind(v, (object *) new); } /* ********************************************************************** * Matrix veneer class - * ********************************************************************* */ + * ********************************************************************** */ -/** Constructs a Matrix object */ -value matrix_constructor(vm *v, int nargs, value *args) { - unsigned int nrows, ncols; - objectmatrix *new=NULL; - value out=MORPHO_NIL; - - if (nargs==2 && - MORPHO_ISINTEGER(MORPHO_GETARG(args, 0)) && - MORPHO_ISINTEGER(MORPHO_GETARG(args, 1)) ) { - nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - ncols = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); - new=object_newmatrix(nrows, ncols, true); - } else if (nargs==1 && - MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - ncols = 1; - new=object_newmatrix(nrows, ncols, true); - } else if (nargs==1 && - MORPHO_ISARRAY(MORPHO_GETARG(args, 0))) { - new=object_matrixfromarray(MORPHO_GETARRAY(MORPHO_GETARG(args, 0))); - if (!new) morpho_runtimeerror(v, MATRIX_INVLDARRAYINIT); -#ifdef MORPHO_INCLUDE_SPARSE - } else if (nargs==1 && - MORPHO_ISLIST(MORPHO_GETARG(args, 0))) { - new=object_matrixfromlist(MORPHO_GETLIST(MORPHO_GETARG(args, 0))); - if (!new) { - /** Could this be a concatenation operation? */ - objectsparseerror err = sparse_catmatrix(MORPHO_GETLIST(MORPHO_GETARG(args, 0)), &new); - if (err==SPARSE_INVLDINIT) { - morpho_runtimeerror(v, MATRIX_INVLDARRAYINIT); - } else if (err!=SPARSE_OK) sparse_raiseerror(v, err); - } -#endif - } else if (nargs==1 && - MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { - new=object_clonematrix(MORPHO_GETMATRIX(MORPHO_GETARG(args, 0))); - if (!new) morpho_runtimeerror(v, MATRIX_INVLDARRAYINIT); -#ifdef MORPHO_INCLUDE_SPARSE - } else if (nargs==1 && - MORPHO_ISSPARSE(MORPHO_GETARG(args, 0))) { - objectsparseerror err=sparse_tomatrix(MORPHO_GETSPARSE(MORPHO_GETARG(args, 0)), &new); - if (err!=SPARSE_OK) morpho_runtimeerror(v, MATRIX_INVLDARRAYINIT); -#endif - } else morpho_runtimeerror(v, MATRIX_CONSTRUCTOR); - - if (new) { - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } - - return out; +/* ---------------------- + * Common utility methods + * ---------------------- */ + +/** Prints a matrix */ +value Matrix_print(vm *v, int nargs, value *args) { + if (MORPHO_ISCLASS(MORPHO_SELF(args))) return Object_print(v, nargs, args); // Handle calls on the class + objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); + matrix_print(v, m); + return MORPHO_NIL; } -/** Creates an identity matrix */ -value matrix_identityconstructor(vm *v, int nargs, value *args) { - int n; - objectmatrix *new=NULL; - value out = MORPHO_NIL; - - if (nargs==1 && - MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - n = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - new=object_newmatrix(n, n, false); - if (new) { - matrix_identity(new); - } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); - } else morpho_runtimeerror(v, MATRIX_IDENTCONSTRUCTOR); - - if (new) { - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } +/** Formatted conversion to a string */ +value Matrix_format(vm *v, int nargs, value *args) { + value out=MORPHO_NIL; + varray_char str; + varray_charinit(&str); + + if (matrix_printtobuffer(MORPHO_GETMATRIX(MORPHO_SELF(args)), + MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)), + &str)) { + out = object_stringfromvarraychar(&str); + if (MORPHO_ISOBJECT(out)) morpho_bindobjects(v, 1, &out); + } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + varray_charclear(&str); return out; } -/** Checks that a matrix is indexed with 2 indices with a generic interface */ -bool matrix_slicedim(value * a, unsigned int ndim){ - if (ndim>2||ndim<0) return false; - return true; +/** Copies the contents of one matrix into another */ +value Matrix_assign(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + LINALG_ERRCHECKVM(matrix_copy(b, a)); + return MORPHO_NIL; } -/** Constucts a new matrix with a generic interface */ -void matrix_sliceconstructor(unsigned int *slicesize,unsigned int ndim,value* out){ - unsigned int numcol = 1; - if (ndim == 2) { - numcol = slicesize[1]; - } - *out = MORPHO_OBJECT(object_newmatrix(slicesize[0],numcol,false)); +/** Clones a matrix */ +value Matrix_clone(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *new=matrix_clone(a); + return morpho_wrapandbind(v, (object *) new); } -/** Copies data from a at indx to out at newindx with a generic interface */ -objectarrayerror matrix_slicecopy(value * a,value * out, unsigned int ndim, unsigned int *indx,unsigned int *newindx){ - double num; // matrices store doubles; - unsigned int colindx = 0; - unsigned int colnewindx = 0; - - if (ndim == 2) { - colindx = indx[1]; - colnewindx = newindx[1]; - } - if (!(matrix_getelement(MORPHO_GETMATRIX(*a),indx[0],colindx,&num)&& - matrix_setelement(MORPHO_GETMATRIX(*out),newindx[0],colnewindx,num))){ - return ARRAY_OUTOFBOUNDS; - } - return ARRAY_OK; -} +/* --------- + * index() + * --------- */ -/** Rolls the matrix list */ -void matrix_rollflat(objectmatrix *a, objectmatrix *b, int nplaces) { - unsigned int N = a->nrows*a->ncols; - int n = abs(nplaces); - if (n>N) n = n % N; - unsigned int Np = N - n; // Number of elements to roll +value Matrix_index__int_int(vm *v, int nargs, value *args) { + objectmatrix *m = MORPHO_GETMATRIX(MORPHO_SELF(args)); + MatrixIdx_t i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)), + j = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); + value out=MORPHO_NIL; - if (nplaces<0) { - memcpy(b->matrixdata, a->matrixdata+n, sizeof(double)*Np); - memcpy(b->matrixdata+Np, a->matrixdata, sizeof(double)*n); - } else { - memcpy(b->matrixdata+n, a->matrixdata, sizeof(double)*Np); - if (n>0) memcpy(b->matrixdata, a->matrixdata+Np, sizeof(double)*n); - } + double *elptr=NULL; + LINALG_ERRCHECKVM(matrix_getelementptr(m, i, j, &elptr)); + + if (elptr) out=matrix_getinterface(m)->getelfn(v, elptr); + return out; } -/** Copies arow from matrix a into brow for matrix b */ -void matrix_copyrow(objectmatrix *a, int arow, objectmatrix *b, int brow) { - cblas_dcopy(a->ncols, a->elements+arow, a->nrows, b->elements+brow, a->nrows); +static linalgError_t _slice_count(value in, MatrixIdx_t *count) { + if (morpho_isnumber(in)) { *count=1; return LINALGERR_OK; } + else if (MORPHO_ISRANGE(in)) { *count = (MatrixIdx_t) range_count(MORPHO_GETRANGE(in)); return LINALGERR_OK; } + else if (MORPHO_ISLIST(in)) { *count = (MatrixIdx_t) list_length(MORPHO_GETLIST(in)); return LINALGERR_OK; } + else if (MORPHO_ISTUPLE(in)) { *count = (MatrixIdx_t) tuple_length(MORPHO_GETTUPLE(in)); return LINALGERR_OK; } + return LINALGERR_NON_NUMERICAL; } -/** Rolls a list by a number of elements */ -objectmatrix *matrix_roll(objectmatrix *a, int nplaces, int axis) { - objectmatrix *new=object_newmatrix(a->nrows, a->ncols, false); - - if (new) { - switch(axis) { - case 0: { // TODO: Could probably be faster - for (int i=0; inrows; i++) { - int j = (i+nplaces); - if (j<0) j+=a->nrows; - matrix_copyrow(a, i, new, j % a->nrows); - } - } - break; - case 1: matrix_rollflat(a, new, nplaces*a->nrows); break; +static linalgError_t _slice_iterate(value in, unsigned int i, MatrixIdx_t *ix) { + value val=in; + if (MORPHO_ISRANGE(in)) { + val=range_iterate(MORPHO_GETRANGE(in), i); + } else if (MORPHO_ISLIST(in)) { + if (!list_getelement(MORPHO_GETLIST(in), i, &val)) return LINALGERR_INVLD_ARG; + } else if (MORPHO_ISTUPLE(in)) { + if (!tuple_getelement(MORPHO_GETTUPLE(in), i, &val)) return LINALGERR_INVLD_ARG; + } + + if (MORPHO_ISINTEGER(val)) { *ix=MORPHO_GETINTEGERVALUE(val); return LINALGERR_OK; } + else if (MORPHO_ISFLOAT(val)) { *ix=(MatrixIdx_t) MORPHO_GETFLOATVALUE(val); return LINALGERR_OK; } + return LINALGERR_INVLD_ARG; +} + +static linalgError_t _slice_validate(value iv, value jv, MatrixIdx_t *icnt, MatrixIdx_t *jcnt) { + LINALG_ERRCHECKRETURN(_slice_count(iv, icnt)); + LINALG_ERRCHECKRETURN(_slice_count(jv, jcnt)); + if (*icnt<1 || *jcnt<1) return LINALGERR_INVLD_ARG; + return LINALGERR_OK; +} + +static linalgError_t _slice_copy(value iv, value jv, MatrixIdx_t icnt, MatrixIdx_t jcnt, objectmatrix *a, objectmatrix *b, bool swap) { + double *ael, *bel; + for (MatrixIdx_t j=0; jncols)); + for (MatrixIdx_t i=0; inrows)); + LINALG_ERRCHECKRETURN(matrix_getelementptr(a, ix, jx, &ael)); + LINALG_ERRCHECKRETURN(matrix_getelementptr(b, i, j, &bel)); + if (swap) memcpy(ael, bel, sizeof(double)*a->nvals); + else memcpy(bel, ael, sizeof(double)*b->nvals); } } - - return new; + return LINALGERR_OK; } -/** Gets the matrix element with given indices */ -value Matrix_getindex(vm *v, int nargs, value *args) { - objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); - unsigned int indx[2]={0,0}; - value out = MORPHO_NIL; - if (nargs>2){ - morpho_runtimeerror(v, MATRIX_INVLDNUMINDICES); - return out; - } - - if (array_valuelisttoindices(nargs, args+1, indx)) { - double outval; - if (!matrix_getelement(m, indx[0], indx[1], &outval)) { - morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); - } else { - out = MORPHO_FLOAT(outval); - } - } else { // now try to get a slice - objectarrayerror err = getslice(&MORPHO_SELF(args), &matrix_slicedim, &matrix_sliceconstructor, &matrix_slicecopy, nargs, &MORPHO_GETARG(args,0), &out); - if (err!=ARRAY_OK) MORPHO_RAISE(v, array_to_matrix_error(err) ); - if (MORPHO_ISOBJECT(out)){ - morpho_bindobjects(v,1,&out); - } else morpho_runtimeerror(v, MATRIX_INVLDINDICES); - } +static value _index_slice(vm *v, objectmatrix *m, value iv, value jv) { + objectmatrix *new=NULL; + value out=MORPHO_NIL; + + MatrixIdx_t icnt=0, jcnt=0; + LINALG_ERRCHECKVMRETURN(_slice_validate(iv, jv, &icnt, &jcnt), MORPHO_NIL); + + new=matrix_newwithtype(OBJECT_GETTYPE(m), icnt, jcnt, m->nvals, false); + if (!new) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); return MORPHO_NIL; } + + linalgError_t err=_slice_copy(iv, jv, icnt, jcnt, m, new, false); + if (err!=LINALGERR_OK) { linalg_raiseerror(v, err); object_free((object *) new); } + else out = morpho_wrapandbind(v, (object *) new); + return out; } -/** Sets the matrix element with given indices */ -value Matrix_setindex(vm *v, int nargs, value *args) { - objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); - unsigned int indx[2]={0,0}; - - if (array_valuelisttoindices(nargs-1, args+1, indx)) { - double value=0.0; - if (MORPHO_ISFLOAT(args[nargs])) value=MORPHO_GETFLOATVALUE(args[nargs]); - if (MORPHO_ISINTEGER(args[nargs])) value=(double) MORPHO_GETINTEGERVALUE(args[nargs]); +value Matrix_index__x_x(vm *v, int nargs, value *args) { + objectmatrix *m = MORPHO_GETMATRIX(MORPHO_SELF(args)); + value iv=MORPHO_GETARG(args, 0), jv=MORPHO_GETARG(args, 1); + return _index_slice(v, m, iv, jv); +} - if (!matrix_setelement(m, indx[0], indx[1], value)) { - morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); - } - } else morpho_runtimeerror(v, MATRIX_INVLDINDICES); +value Matrix_index__x(vm *v, int nargs, value *args) { + objectmatrix *m = MORPHO_GETMATRIX(MORPHO_SELF(args)); + value indx = MORPHO_GETARG(args, 0); + if (m->ncols==1) { + return _index_slice(v, m, indx, MORPHO_INTEGER(0)); + } else if (m->nrows==1) { + return _index_slice(v, m, MORPHO_INTEGER(0), indx); + } + + morpho_runtimeerror(v, LINALG_INVLDINDICES); return MORPHO_NIL; } -/** Sets the column of a matrix */ -value Matrix_setcolumn(vm *v, int nargs, value *args) { - objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); - - if (nargs==2 && - MORPHO_ISINTEGER(MORPHO_GETARG(args, 0)) && - MORPHO_ISMATRIX(MORPHO_GETARG(args, 1))) { - unsigned int col = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - objectmatrix *src = MORPHO_GETMATRIX(MORPHO_GETARG(args, 1)); - - if (colncols) { - if (src && src->ncols*src->nrows==m->nrows) { - matrix_setcolumn(m, col, src->elements); - } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); - } else morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); - } else morpho_runtimeerror(v, MATRIX_SETCOLARGS); - +value Matrix_index__err(vm *v, int nargs, value *args) { + morpho_runtimeerror(v, LINALG_INVLDINDICES); return MORPHO_NIL; } -/** Gets a column of a matrix */ -value Matrix_getcolumn(vm *v, int nargs, value *args) { - objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); - value out=MORPHO_NIL; - - if (nargs==1 && - MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - unsigned int col = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - - if (colncols) { - double *vals; - if (matrix_getcolumn(m, col, &vals)) { - objectmatrix *new=object_matrixfromfloats(m->nrows, 1, vals); - if (new) { - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } - } - } else morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); - } else morpho_runtimeerror(v, MATRIX_SETCOLARGS); - - return out; +/* --------- + * setindex() + * --------- */ + +static void _setindex(vm *v, objectmatrix *m, MatrixIdx_t i, MatrixIdx_t j, value in) { + double *elptr=NULL; + LINALG_ERRCHECKVM(matrix_getelementptr(m, i, j, &elptr)); + if (elptr) LINALG_ERRCHECKVM(matrix_getinterface(m)->setelfn(v, in, elptr)); } -/** Prints a matrix */ -value Matrix_print(vm *v, int nargs, value *args) { - value self = MORPHO_SELF(args); - if (!MORPHO_ISMATRIX(self)) return Object_print(v, nargs, args); - - objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); - matrix_print(v, m); +value Matrix_setindex__int_x(vm *v, int nargs, value *args) { + MatrixIdx_t i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + _setindex(v, MORPHO_GETMATRIX(MORPHO_SELF(args)), i, 0, MORPHO_GETARG(args, 1)); return MORPHO_NIL; } -/** Formatted conversion to a string */ -value Matrix_format(vm *v, int nargs, value *args) { - value out = MORPHO_NIL; - - if (nargs==1 && - MORPHO_ISSTRING(MORPHO_GETARG(args, 0))) { - varray_char str; - varray_charinit(&str); - - if (matrix_printtobuffer(MORPHO_GETMATRIX(MORPHO_SELF(args)), - MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)), - &str)) { - out = object_stringfromvarraychar(&str); - if (MORPHO_ISOBJECT(out)) morpho_bindobjects(v, 1, &out); - } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); - - varray_charclear(&str); - } else { - morpho_runtimeerror(v, VALUE_FRMTARG); - } - - return out; +value Matrix_setindex__int_int_x(vm *v, int nargs, value *args) { + MatrixIdx_t i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + MatrixIdx_t j = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); + _setindex(v, MORPHO_GETMATRIX(MORPHO_SELF(args)), i, j, MORPHO_GETARG(args, 2)); + return MORPHO_NIL; } -/** Matrix add */ -value Matrix_assign(vm *v, int nargs, value *args) { - objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - - if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { - objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); - - if (a->ncols==b->ncols && a->nrows==b->nrows) { - matrix_copy(b, a); - } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); - } +value Matrix_setindex__x_x_matrix(vm *v, int nargs, value *args) { + objectmatrix *m = MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *msrc = MORPHO_GETMATRIX(MORPHO_GETARG(args, 2)); + value iv=MORPHO_GETARG(args, 0), jv=MORPHO_GETARG(args, 1); + + MatrixIdx_t icnt=0, jcnt=0; + LINALG_ERRCHECKVMRETURN(_slice_validate(iv, jv, &icnt, &jcnt), MORPHO_NIL); + + LINALG_ERRCHECKVM(_slice_copy(iv, jv, icnt, jcnt, m, msrc, true)); return MORPHO_NIL; } -/** Matrix add */ -value Matrix_add(vm *v, int nargs, value *args) { +/* --------- + * column + * --------- */ + +value Matrix_getcolumn__int(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + MatrixIdx_t i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); value out=MORPHO_NIL; - - if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { - objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); - - if (a->ncols==b->ncols && a->nrows==b->nrows) { - objectmatrix *new = object_newmatrix(a->nrows, a->ncols, false); - if (new) { - out=MORPHO_OBJECT(new); - matrix_add(a, b, new); - } - } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); - } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { - double val; - if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { - objectmatrix *new = object_newmatrix(a->nrows, a->ncols, false); - if (new) { - out=MORPHO_OBJECT(new); - matrix_addscalar(a, 1.0, val, new); - } - } - } else morpho_runtimeerror(v, MATRIX_ARITHARGS); - if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); + if (i>=0 && incols) { + objectmatrix *new=matrix_newwithtype(OBJECT_GETTYPE(a), a->nrows, 1, a->nvals, false); + if (new) matrix_getcolumn(a, i, new); + out=morpho_wrapandbind(v, (object *)new); + } else linalg_raiseerror(v, LINALGERR_INDX_OUT_OF_BNDS); return out; } -/** Right add */ -value Matrix_addr(vm *v, int nargs, value *args) { - objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); +value Matrix_setcolumn__int_matrix(vm *v, int nargs, value *args) { + LINALG_ERRCHECKVM(matrix_setcolumn(MORPHO_GETMATRIX(MORPHO_SELF(args)), + MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)), + MORPHO_GETMATRIX(MORPHO_GETARG(args, 1)))); + return MORPHO_NIL; +} + +/* ---------- + * Arithmetic + * ---------- */ + +/** Add a vector */ +static value _axpy(vm *v, int nargs, value *args, double alpha) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); // Receiver is left hand operand + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); // Argument is right hand operand + objectmatrix *new = NULL; value out=MORPHO_NIL; - - if (nargs==1 && (MORPHO_ISNIL(MORPHO_GETARG(args, 0)) || - MORPHO_ISNUMBER(MORPHO_GETARG(args, 0)))) { - int i=0; - if (MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) i=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - if (MORPHO_ISFLOAT(MORPHO_GETARG(args, 0))) i=(fabs(MORPHO_GETFLOATVALUE(MORPHO_GETARG(args, 0)))ncols==b->ncols && a->nrows==b->nrows) { + new=matrix_clone(a); + if (new) LINALG_ERRCHECKVM(matrix_axpy(alpha, b, new)); + out = morpho_wrapandbind(v, (object *) new); + } else morpho_runtimeerror(v, LINALG_INCOMPATIBLEMATRICES); return out; } -/** Matrix subtract */ -value Matrix_sub(vm *v, int nargs, value *args) { +/** Add a scalar */ +static value _xpa(vm *v, int nargs, value *args, double sgna, double sgnb) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *new=NULL; value out=MORPHO_NIL; - - if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { - objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); - - if (a->ncols==b->ncols && a->nrows==b->nrows) { - objectmatrix *new = object_newmatrix(a->nrows, a->ncols, false); - if (new) { - out=MORPHO_OBJECT(new); - matrix_sub(a, b, new); - } - } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); - } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { - double val; - if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { - objectmatrix *new = object_newmatrix(a->nrows, a->ncols, false); - if (new) { - out=MORPHO_OBJECT(new); - matrix_addscalar(a, 1.0, -val, new); - } - } - } else morpho_runtimeerror(v, MATRIX_ARITHARGS); - if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); + double beta; + if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &beta)) { + new = matrix_clone(a); + if (new) LINALG_ERRCHECKVM(matrix_addscalar(new, sgna, beta*sgnb)); + out = morpho_wrapandbind(v, (object *) new); + } else morpho_runtimeerror(v, LINALG_INVLDARGS); return out; } -/** Right subtract */ -value Matrix_subr(vm *v, int nargs, value *args) { - objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - value out=MORPHO_NIL; - - if (nargs==1 && (MORPHO_ISNIL(MORPHO_GETARG(args, 0)) || - MORPHO_ISNUMBER(MORPHO_GETARG(args, 0)))) { - int i=(MORPHO_ISNIL(MORPHO_GETARG(args, 0)) ? 0 : MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0))); +value Matrix_add__matrix(vm *v, int nargs, value *args) { + return _axpy(v,nargs,args,1.0); +} - if (MORPHO_ISFLOAT(MORPHO_GETARG(args, 0))) i=(fabs(MORPHO_GETFLOATVALUE(MORPHO_GETARG(args, 0)))nrows, a->ncols, false); - if (new) { - matrix_addscalar(a, 1.0, -val, new); - // now that did self - arg[0] and we want arg[0] - self so scale the whole thing by -1 - matrix_scale(new, -1.0); - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } - } +value Matrix_add__x(vm *v, int nargs, value *args) { + if (matrix_isamatrix(MORPHO_GETARG(args, 0))) return MORPHO_NIL; // Redirect to addr + return _xpa(v,nargs,args,1.0,1.0); +} + +value Matrix_sub__matrix(vm *v, int nargs, value *args) { + return _axpy(v,nargs,args,-1.0); +} + +value Matrix_sub__x(vm *v, int nargs, value *args) { + if (matrix_isamatrix(MORPHO_GETARG(args, 0))) return MORPHO_NIL; // Redirect to subr + return _xpa(v,nargs,args,1.0,-1.0); +} - } else morpho_runtimeerror(v, VM_INVALIDARGS); - } else morpho_runtimeerror(v, VM_INVALIDARGS); +value Matrix_subr__x(vm *v, int nargs, value *args) { + return _xpa(v,nargs,args,-1.0,1.0); +} + +value Matrix_mul__float(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - return out; + double scale; + if (!morpho_valuetofloat(MORPHO_GETARG(args, 0), &scale)) return MORPHO_NIL; + + objectmatrix *new = matrix_clone(a); + if (new) matrix_scale(new, scale); + return morpho_wrapandbind(v, (object *) new); } -/** Matrix multiply */ -value Matrix_mul(vm *v, int nargs, value *args) { +value Matrix_mul__matrix(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); value out=MORPHO_NIL; - - if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { - objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); - - if (a->ncols==b->nrows) { - objectmatrix *new = object_newmatrix(a->nrows, b->ncols, false); - if (new) { - out=MORPHO_OBJECT(new); - matrix_mul(a, b, new); - morpho_bindobjects(v, 1, &out); - } - } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); - } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { - double scale=1.0; - if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &scale)) { - objectmatrix *new = object_clonematrix(a); - if (new) { - out=MORPHO_OBJECT(new); - matrix_scale(new, scale); - morpho_bindobjects(v, 1, &out); - } - } -#ifdef MORPHO_INCLUDE_SPARSE - } else if (nargs==1 && MORPHO_ISSPARSE(MORPHO_GETARG(args, 0))) { - // Returns nil to ensure it gets passed to mulr on Sparse -#endif - } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + if (a->ncols==b->nrows) { + objectmatrix *new = matrix_new(a->nrows, b->ncols, false); + if (new) LINALG_ERRCHECKVM(matrix_mmul(1.0, a, b, 0.0, new)); + out = morpho_wrapandbind(v, (object *) new); + } else morpho_runtimeerror(v, LINALG_INCOMPATIBLEMATRICES); return out; } -/** Called when multiplying on the right */ -value Matrix_mulr(vm *v, int nargs, value *args) { +value Matrix_div__float(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - value out=MORPHO_NIL; - - if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { - double scale=1.0; - if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &scale)) { - objectmatrix *new = object_clonematrix(a); - if (new) { - out=MORPHO_OBJECT(new); - matrix_scale(new, scale); - morpho_bindobjects(v, 1, &out); - } - } - } else morpho_runtimeerror(v, MATRIX_ARITHARGS); - return out; + double scale; + if (!morpho_valuetofloat(MORPHO_GETARG(args, 0), &scale)) return MORPHO_NIL; + scale = 1.0/scale; + if (isnan(scale)) morpho_runtimeerror(v, VM_DVZR); + + objectmatrix *new = matrix_clone(a); + if (new) matrix_scale(new, scale); + return morpho_wrapandbind(v, (object *) new); } -/** Solution of linear system a.x = b (i.e. x = b/a) */ -value Matrix_div(vm *v, int nargs, value *args) { - objectmatrix *b=MORPHO_GETMATRIX(MORPHO_SELF(args)); - value out=MORPHO_NIL; - - if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { - objectmatrix *a=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); - - if (a->ncols==b->nrows) { - objectmatrix *new = object_newmatrix(b->nrows, b->ncols, false); - if (new) { - objectmatrixerror err; - if (MATRIX_ISSMALL(a)) { - err=matrix_divs(a, b, new); - } else { - err=matrix_divl(a, b, new); - } - if (err==MATRIX_SING) { - morpho_runtimeerror(v, MATRIX_SINGULAR); - object_free((object *) new); - } else { - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } - } - } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); -#ifdef MORPHO_INCLUDE_SPARSE - } else if (nargs==1 && MORPHO_ISSPARSE(MORPHO_GETARG(args, 0))) { - /* Division by a sparse matrix: redirect to the divr selector of Sparse. */ - value vargs[2]={args[1],args[0]}; - return Sparse_divr(v, nargs, vargs); -#endif - } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { - /* Division by a scalar */ - double scale=1.0; - if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &scale)) { - if (fabs(scale)ncols==b->ncols && a->nrows==b->nrows) { - out=MORPHO_SELF(args); - double lambda=1.0; - morpho_valuetofloat(MORPHO_GETARG(args, 0), &lambda); - matrix_accumulate(a, lambda, b); - } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); - } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 1)); + + double alpha=1.0; + if (!morpho_valuetofloat(MORPHO_GETARG(args, 0), &alpha)) { morpho_runtimeerror(v, LINALG_ARITHARGS); return MORPHO_NIL; } + LINALG_ERRCHECKVM(matrix_axpy(alpha, b, a)); return MORPHO_NIL; } -/** Frobenius inner product */ -value Matrix_inner(vm *v, int nargs, value *args) { +/* ---------------- + * Unary operations + * ---------------- */ + +/** Matrix norm */ +value Matrix_norm__x(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - value out=MORPHO_NIL; - - if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { - objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); - - double prod=0.0; - if (matrix_inner(a, b, &prod)==MATRIX_OK) { - out = MORPHO_FLOAT(prod); - } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); - } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + double n; - return out; + if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &n)) { + if (fabs(n-1.0)nrows*a->ncols, b->nrows*b->ncols, true); - - if (new && - matrix_outer(a, b, new)==MATRIX_OK) { - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); - } else morpho_runtimeerror(v, MATRIX_ARITHARGS); - - return out; + return MORPHO_FLOAT(matrix_norm(a, MATRIX_NORM_FROBENIUS)); } -/** Matrix sum */ +/** Sums all matrix values */ value Matrix_sum(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - return MORPHO_FLOAT(matrix_sum(a)); + double sum[a->nvals]; + + matrix_sum(a, sum); + return matrix_getinterface(a)->getelfn(v, sum); } -/** Roll a matrix */ -value Matrix_roll(vm *v, int nargs, value *args) { - objectmatrix *slf = MORPHO_GETMATRIX(MORPHO_SELF(args)); - value out = MORPHO_NIL; - int roll, axis=0; +/** Computes the trace */ +value Matrix_trace(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + double out=0.0; + LINALG_ERRCHECKVM(matrix_trace(a, &out)); + return MORPHO_FLOAT(out); +} - if (nargs>0 && - morpho_valuetoint(MORPHO_GETARG(args, 0), &roll)) { - - if (nargs==2 && !morpho_valuetoint(MORPHO_GETARG(args, 1), &axis)) return out; - - objectmatrix *new = matrix_roll(slf, roll, axis); +/** Inverts a matrix */ +value Matrix_transpose(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *new = matrix_clone(a); + if (new) { + new->ncols=a->nrows; + new->nrows=a->ncols; + LINALG_ERRCHECKVM(matrix_transpose(a, new)); + } + return morpho_wrapandbind(v, (object *) new); +} - if (new) { - out = MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } +/** Inverts a matrix */ +value Matrix_inverse(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *new = matrix_clone(a); + if (new) LINALG_ERRCHECKVM(matrix_inverse(new)); + + return morpho_wrapandbind(v, (object *) new); +} - } else morpho_runtimeerror(v, LIST_ADDARGS); +/* ---------------- + * Eigensystem + * ---------------- */ - return out; +static bool _processeigenvalues(vm *v, MatrixIdx_t n, MorphoComplex *w, value *out) { + value ev[n]; + for (int i=0; i DBL_MIN ? fabs(cimag(w[i]))/abs <= MORPHO_EPS : fabs(cimag(w[i])) < DBL_MIN) { + ev[i]=MORPHO_FLOAT(creal(w[i])); + } else { + objectcomplex *new = object_newcomplex(creal(w[i]), cimag(w[i])); + if (new) ev[i]=MORPHO_OBJECT(new); + else goto _processeigenvalues_cleanup; + } + } + + objecttuple *new = object_newtuple(n, ev); + if (!new) goto _processeigenvalues_cleanup; + + *out = MORPHO_OBJECT(new); + return true; + +_processeigenvalues_cleanup: + for (int i=0; incols; + MorphoComplex w[n]; + linalgError_t err=matrix_eigen(a, w, NULL); + if (err==LINALGERR_OK) { + if (_processeigenvalues(v, n, w, &out)) { + morpho_bindrecursive(v, out); + } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + } else linalg_raiseerror(v, err); return out; } -/** Matrix eigenvalues */ -value Matrix_eigenvalues(vm *v, int nargs, value *args) { +#define _CHK(x) if (!x) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); goto _eigensystem_cleanup; } + +/** Finds the eigenvalues and eigenvectors of a matrix */ +value Matrix_eigensystem(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - value evals=MORPHO_NIL; - if (matrix_eigen(v, a, &evals, NULL)) { - objectlist *new = MORPHO_GETLIST(evals); - list_append(new, evals); // Ensure we retain the List object - morpho_bindobjects(v, new->val.count, new->val.data); - new->val.count--; // And pop it back off + value ev=MORPHO_NIL; // Will hold eigenvalues + objectmatrix *evec=NULL; // Holds eigenvectors + objecttuple *otuple=NULL; // Tuple to return everything + + MatrixIdx_t n=a->ncols; + MorphoComplex w[n]; + + evec=matrix_clone(a); + _CHK(evec); + + linalgError_t err=matrix_eigen(a, w, evec); + if (err!=LINALGERR_OK) { linalg_raiseerror(v, err); goto _eigensystem_cleanup; } + + _CHK(_processeigenvalues(v, n, w, &ev)); + + value outtuple[2] = { ev, MORPHO_OBJECT(evec) }; + otuple = object_newtuple(2, outtuple); + _CHK(otuple); + + return morpho_wrapandbindrecursive(v, (object *) otuple); + +_eigensystem_cleanup: + if (evec) object_free((object *) evec); + if (otuple) object_free((object *) otuple); + if (MORPHO_ISOBJECT(ev)) { + value evx; + objecttuple *t = MORPHO_GETTUPLE(ev); + for (int i=0; inrows != u->nrows) || (a->nrows != u->ncols))) return LINALGERR_INCOMPATIBLE_DIM; + if (vt && ((a->ncols != vt->nrows) || (a->ncols != vt->ncols))) return LINALGERR_INCOMPATIBLE_DIM; - if (matrix_eigen(v, a, &evals, &evecs)) { - objectlist *evallist = MORPHO_GETLIST(evals); - - list_append(resultlist, evals); // Create the output list - list_append(resultlist, evecs); - out=MORPHO_OBJECT(resultlist); - - list_append(evallist, evals); // Ensure we bind all objects at once - list_append(evallist, evecs); // by popping them onto the evallist. - list_append(evallist, out); // - morpho_bindobjects(v, evallist->val.count, evallist->val.data); - evallist->val.count-=3; // and then popping them back off. - } + objectmatrix *temp = matrix_clone(a); + if (!temp) return LINALGERR_ALLOC; - return out; + linalgError_t err = matrix_getinterface(a)->svdfn (temp, s, u, vt); + object_free((object *) temp); + return err; } -/** Inverts a matrix */ -value Matrix_inverse(vm *v, int nargs, value *args) { - objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - value out=MORPHO_NIL; +/* ---------------- + * QR decomposition + * ---------------- */ - // The inverse will have the number of rows and number of columns - // swapped. - objectmatrix *new = object_newmatrix(a->ncols, a->nrows, false); - if (new) { - objectmatrixerror mi = matrix_inverse(a, new); - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - - if (mi!=MATRIX_OK) matrix_raiseerror(v, mi); - } +/** Interface to QR decomposition */ +linalgError_t matrix_qr(objectmatrix *a, objectmatrix *q, objectmatrix *r) { + if (q && ((a->nrows != q->nrows) || (a->nrows != q->ncols))) return LINALGERR_INCOMPATIBLE_DIM; + if (r && ((a->nrows != r->nrows) || (a->ncols != r->ncols))) return LINALGERR_INCOMPATIBLE_DIM; - return out; + objectmatrix *temp = matrix_clone(a); + if (!temp) return LINALGERR_ALLOC; + + linalgError_t err = matrix_getinterface(a)->qrfn (temp, q, r); + object_free((object *) temp); + return err; } -/** Transpose of a matrix */ -value Matrix_transpose(vm *v, int nargs, value *args) { +/** Processes singular values into a tuple */ +static bool _processsingularvalues(vm *v, MatrixIdx_t n, double *s, value *out) { + value sv[n]; + for (int i = 0; i < n; i++) sv[i] = MORPHO_FLOAT(s[i]); + + objecttuple *new = object_newtuple(n, sv); + if (!new) return false; + + *out = MORPHO_OBJECT(new); + return true; +} + +#define _CHK_SVD(x) if (!x) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); goto _svd_cleanup; } +/** Singular Value Decomposition */ +value Matrix_svd(vm *v, int nargs, value *args) { + objectmatrix *a = MORPHO_GETMATRIX(MORPHO_SELF(args)); + + value s = MORPHO_NIL; // Will hold singular values + objectmatrix *u = NULL; // Left singular vectors + objectmatrix *vt = NULL; // Right singular vectors (transposed) + objecttuple *otuple = NULL; // Tuple to return everything + + MatrixIdx_t m = a->nrows, n = a->ncols; + MatrixIdx_t minmn = (m < n) ? m : n; + double singular_values[minmn]; + + // Allocate U (m×m) and VT (n×n) matrices + u = matrix_newwithtype(MORPHO_GETOBJECTTYPE(MORPHO_SELF(args)), m, m, a->nvals, false); + _CHK_SVD(u); + + vt = matrix_newwithtype(MORPHO_GETOBJECTTYPE(MORPHO_SELF(args)), n, n, a->nvals, false); + _CHK_SVD(vt); + + linalgError_t err = matrix_svd(a, singular_values, u, vt); + if (err != LINALGERR_OK) { linalg_raiseerror(v, err); goto _svd_cleanup; } + + _CHK_SVD(_processsingularvalues(v, minmn, singular_values, &s)); + + value outtuple[3] = { MORPHO_OBJECT(u), s, MORPHO_OBJECT(vt) }; + otuple = object_newtuple(3, outtuple); + _CHK_SVD(otuple); + + return morpho_wrapandbindrecursive(v, (object *) otuple); + +_svd_cleanup: + if (u) object_free((object *) u); + if (vt) object_free((object *) vt); + if (otuple) object_free((object *) otuple); + morpho_freeobject(s); + + return MORPHO_NIL; +} +#undef _CHK_SVD + +/* ---------------- + * QR decomposition + * ---------------- */ + +#define _CHK_QR(x) if (!x) { morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); goto _qr_cleanup; } +/** QR Decomposition */ +value Matrix_qr(vm *v, int nargs, value *args) { + objectmatrix *a = MORPHO_GETMATRIX(MORPHO_SELF(args)); + + objectmatrix *q = NULL; // Orthogonal matrix Q + objectmatrix *r = NULL; // Upper triangular matrix R + objecttuple *otuple = NULL; // Tuple to return everything + + MatrixIdx_t m = a->nrows, n = a->ncols; + + // Allocate Q (m×m) and R (m×n) matrices + q = matrix_newwithtype(MORPHO_GETOBJECTTYPE(MORPHO_SELF(args)), m, m, a->nvals, false); + _CHK_QR(q); + + r = matrix_newwithtype(MORPHO_GETOBJECTTYPE(MORPHO_SELF(args)), m, n, a->nvals, false); + _CHK_QR(r); + + linalgError_t err = matrix_qr(a, q, r); + if (err != LINALGERR_OK) { linalg_raiseerror(v, err); goto _qr_cleanup; } + + value outtuple[2] = { MORPHO_OBJECT(q), MORPHO_OBJECT(r) }; + otuple = object_newtuple(2, outtuple); + _CHK_QR(otuple); + + return morpho_wrapandbindrecursive(v, (object *) otuple); + +_qr_cleanup: + if (q) object_free((object *) q); + if (r) object_free((object *) r); + if (otuple) object_free((object *) otuple); + + return MORPHO_NIL; +} +#undef _CHK_QR + +/* --------- + * Products + * --------- */ + +/** Frobenius inner product */ +value Matrix_inner(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - value out=MORPHO_NIL; - - objectmatrix *new = object_newmatrix(a->ncols, a->nrows, false); - if (new) { - matrix_transpose(a, new); - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + double prod=0.0; - return out; + LINALG_ERRCHECKVM(matrix_inner(a, b, &prod)); + + return MORPHO_FLOAT(prod); +} + +/** Outer product */ +value Matrix_outer(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + + objectmatrix *new=matrix_new(a->nrows*a->ncols, b->nrows*b->ncols, true); + if (new) LINALG_ERRCHECKVM(matrix_r1update(1.0, a, b, new)); + + return morpho_wrapandbind(v, (object *) new); } +/* --------- + * Metadata + * --------- */ + /** Reshape a matrix */ value Matrix_reshape(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + int nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)), + ncols = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); - if (nargs==2 && - MORPHO_ISINTEGER(MORPHO_GETARG(args, 0)) && - MORPHO_ISINTEGER(MORPHO_GETARG(args, 1))) { - int nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - int ncols = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); - - if (nrows*ncols==a->nrows*a->ncols) { - a->nrows=nrows; - a->ncols=ncols; - } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); - } else morpho_runtimeerror(v, MATRIX_RESHAPEARGS); + if (nrows*ncols==a->nrows*a->ncols) { + a->nrows=nrows; + a->ncols=ncols; + } else morpho_runtimeerror(v, LINALG_INCOMPATIBLEMATRICES); return MORPHO_NIL; } -/** Trace of a matrix */ -value Matrix_trace(vm *v, int nargs, value *args) { - objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - value out=MORPHO_NIL; +static value _roll(vm *v, objectmatrix *a, int roll, int axis) { + objectmatrix *new = matrix_clone(a); + if (new) matrix_roll(a, roll, axis, new); + return morpho_wrapandbind(v, (object *) new); +} - if (a->nrows==a->ncols) { - double tr; - if (matrix_trace(a, &tr)==MATRIX_OK) out=MORPHO_FLOAT(tr); - } else { - morpho_runtimeerror(v, MATRIX_NOTSQ); - } - - return out; +/** Roll a matrix */ +value Matrix_roll__int_int(vm *v, int nargs, value *args) { + objectmatrix *a = MORPHO_GETMATRIX(MORPHO_SELF(args)); + int roll = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)), + axis = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); + return _roll(v, a, roll, axis); +} + +/** Roll a matrix by row */ +value Matrix_roll__int(vm *v, int nargs, value *args) { + objectmatrix *a = MORPHO_GETMATRIX(MORPHO_SELF(args)); + int roll = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + return _roll(v, a, roll, 0); } /** Enumerate protocol */ value Matrix_enumerate(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + int i = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); value out=MORPHO_NIL; - if (nargs==1) { - if (MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { - int i=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); - - if (i<0) out=MORPHO_INTEGER(a->ncols*a->nrows); - else if (incols*a->nrows) out=MORPHO_FLOAT(a->elements[i]); - } + if (i<0) { + out=MORPHO_INTEGER(a->ncols*a->nrows); + } else if (incols*a->nrows) { + out=matrix_getinterface(a)->getelfn(v, a->elements+i*a->nvals); + } else { + linalg_raiseerror(v, LINALGERR_INDX_OUT_OF_BNDS); } return out; } - /** Number of matrix elements */ value Matrix_count(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - return MORPHO_INTEGER(a->ncols*a->nrows); } /** Matrix dimensions */ value Matrix_dimensions(vm *v, int nargs, value *args) { objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - value dim[2]; - value out=MORPHO_NIL; - dim[0]=MORPHO_INTEGER(a->nrows); - dim[1]=MORPHO_INTEGER(a->ncols); - - objectlist *new=object_newlist(2, dim); - if (new) { - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + value dim[2] = { MORPHO_INTEGER(a->nrows), MORPHO_INTEGER(a->ncols) }; + objecttuple *new=object_newtuple(2, dim); - return out; -} - -/** Clones a matrix */ -value Matrix_clone(vm *v, int nargs, value *args) { - value out=MORPHO_NIL; - objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); - objectmatrix *new=object_clonematrix(a); - if (new) { - out=MORPHO_OBJECT(new); - morpho_bindobjects(v, 1, &out); - } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); - return out; + return morpho_wrapandbind(v, (object *) new); } MORPHO_BEGINCLASS(Matrix) -MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Matrix_getindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Matrix_setindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_GETCOLUMN_METHOD, Matrix_getcolumn, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_SETCOLUMN_METHOD, Matrix_setcolumn, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Matrix_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_FORMAT_METHOD, Matrix_format, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ASSIGN_METHOD, Matrix_assign, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ADD_METHOD, Matrix_add, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ADDR_METHOD, Matrix_addr, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SUB_METHOD, Matrix_sub, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SUBR_METHOD, Matrix_subr, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_MUL_METHOD, Matrix_mul, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_MULR_METHOD, Matrix_mulr, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_DIV_METHOD, Matrix_div, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ACC_METHOD, Matrix_acc, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_INNER_METHOD, Matrix_inner, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_OUTER_METHOD, Matrix_outer, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SUM_METHOD, Matrix_sum, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_NORM_METHOD, Matrix_norm, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_INVERSE_METHOD, Matrix_inverse, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_TRANSPOSE_METHOD, Matrix_transpose, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_RESHAPE_METHOD, Matrix_reshape, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_EIGENVALUES_METHOD, Matrix_eigenvalues, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_EIGENSYSTEM_METHOD, Matrix_eigensystem, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_TRACE_METHOD, Matrix_trace, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Matrix_enumerate, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_COUNT_METHOD, Matrix_count, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_DIMENSIONS_METHOD, Matrix_dimensions, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ROLL_METHOD, Matrix_roll, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Matrix_clone, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD_SIGNATURE(MORPHO_PRINT_METHOD, "()", Matrix_print, MORPHO_FN_IO), +MORPHO_METHOD_SIGNATURE(MORPHO_FORMAT_METHOD, "(String)", Matrix_format, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ASSIGN_METHOD, "(Matrix)", Matrix_assign, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_CLONE_METHOD, "Matrix ()", Matrix_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "Float (Int)", Matrix_enumerate, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "Matrix (Range)", Matrix_index__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "Matrix (List)", Matrix_index__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "Matrix (Tuple)", Matrix_index__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "Float (Int, Int)", Matrix_index__int_int, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "Matrix (_,_)", Matrix_index__x_x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_GETINDEX_METHOD, "Matrix (...)", Matrix_index__err, MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_SETINDEX_METHOD, "(Int,_)", Matrix_setindex__int_x, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MORPHO_SETINDEX_METHOD, "(Int,Int,_)", Matrix_setindex__int_int_x, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MORPHO_SETINDEX_METHOD, "(_,_,Matrix)", Matrix_setindex__x_x_matrix, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MATRIX_GETCOLUMN_METHOD, "Matrix (Int)", Matrix_getcolumn__int, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_SETCOLUMN_METHOD, "(Int, Matrix)", Matrix_setcolumn__int_matrix, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MATRIX_SETCOLUMN_METHOD_DEPRECATED, "(Int, Matrix)", Matrix_setcolumn__int_matrix, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "Matrix (Matrix)", Matrix_add__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "Matrix (Nil)", Matrix_add__nil, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "Matrix (_)", Matrix_add__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ADDR_METHOD, "Matrix (_)", Matrix_add__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ADDR_METHOD, "Matrix (Nil)", Matrix_add__nil, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "Matrix (Matrix)", Matrix_sub__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "Matrix (Nil)", Matrix_add__nil, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "Matrix (_)", Matrix_sub__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_SUBR_METHOD, "Matrix (_)", Matrix_subr__x, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_MUL_METHOD, "Matrix (_)", Matrix_mul__float, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_MUL_METHOD, "Matrix (Matrix)", Matrix_mul__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_MULR_METHOD, "Matrix (_)", Matrix_mul__float, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_DIV_METHOD, "Matrix (Matrix)", Matrix_div__matrix, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_DIV_METHOD, "Matrix (_)", Matrix_div__float, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ACC_METHOD, "(_, Matrix)", Matrix_acc__x_x_matrix, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MATRIX_INVERSE_METHOD, "Matrix ()", Matrix_inverse, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_NORM_METHOD, "Float (_)", Matrix_norm__x, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_NORM_METHOD, "Float ()", Matrix_norm, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MORPHO_SUM_METHOD, "Float ()", Matrix_sum, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MATRIX_TRACE_METHOD, "Float ()", Matrix_trace, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_TRANSPOSE_METHOD, "Matrix ()", Matrix_transpose, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_INNER_METHOD, "Float (Matrix)", Matrix_inner, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_OUTER_METHOD, "Matrix (Matrix)", Matrix_outer, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_EIGENVALUES_METHOD, "Tuple ()", Matrix_eigenvalues, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_EIGENSYSTEM_METHOD, "Tuple ()", Matrix_eigensystem, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_SVD_METHOD, "Tuple ()", Matrix_svd, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_QR_METHOD, "Tuple ()", Matrix_qr, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_RESHAPE_METHOD, "(Int,Int)", Matrix_reshape, MORPHO_FN_MUTATES), +MORPHO_METHOD_SIGNATURE(MATRIX_ROLL_METHOD, "Matrix (Int)", Matrix_roll__int, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MATRIX_ROLL_METHOD, "Matrix (Int,Int)", Matrix_roll__int_int, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_ENUMERATE_METHOD, "(Int)", Matrix_enumerate, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD_SIGNATURE(MORPHO_COUNT_METHOD, "Int ()", Matrix_count, MORPHO_FN_PUREFN), +MORPHO_METHOD_SIGNATURE(MATRIX_DIMENSIONS_METHOD, "Tuple ()", Matrix_dimensions, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS) MORPHO_ENDCLASS /* ********************************************************************** * Initialization - * ********************************************************************* */ + * ********************************************************************** */ void matrix_initialize(void) { objectmatrixtype=object_addtype(&objectmatrixdefn); - - builtin_addfunction(MATRIX_CLASSNAME, matrix_constructor, MORPHO_FN_CONSTRUCTOR); - builtin_addfunction(MATRIX_IDENTITYCONSTRUCTOR, matrix_identityconstructor, BUILTIN_FLAGSEMPTY); + matrix_addinterface(&matrixdefn); objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); @@ -1566,20 +1651,21 @@ void matrix_initialize(void) { value matrixclass=builtin_addclass(MATRIX_CLASSNAME, MORPHO_GETCLASSDEFINITION(Matrix), objclass); object_setveneerclass(OBJECT_MATRIX, matrixclass); - morpho_defineerror(MATRIX_INDICESOUTSIDEBOUNDS, ERROR_HALT, MATRIX_INDICESOUTSIDEBOUNDS_MSG); - morpho_defineerror(MATRIX_INVLDINDICES, ERROR_HALT, MATRIX_INVLDINDICES_MSG); - morpho_defineerror(MATRIX_INVLDNUMINDICES, ERROR_HALT, MATRIX_INVLDNUMINDICES_MSG); - morpho_defineerror(MATRIX_CONSTRUCTOR, ERROR_HALT, MATRIX_CONSTRUCTOR_MSG); - morpho_defineerror(MATRIX_INVLDARRAYINIT, ERROR_HALT, MATRIX_INVLDARRAYINIT_MSG); - morpho_defineerror(MATRIX_ARITHARGS, ERROR_HALT, MATRIX_ARITHARGS_MSG); - morpho_defineerror(MATRIX_RESHAPEARGS, ERROR_HALT, MATRIX_RESHAPEARGS_MSG); - morpho_defineerror(MATRIX_INCOMPATIBLEMATRICES, ERROR_HALT, MATRIX_INCOMPATIBLEMATRICES_MSG); - morpho_defineerror(MATRIX_SINGULAR, ERROR_HALT, MATRIX_SINGULAR_MSG); - morpho_defineerror(MATRIX_NOTSQ, ERROR_HALT, MATRIX_NOTSQ_MSG); - morpho_defineerror(MATRIX_OPFAILED, ERROR_HALT, MATRIX_OPFAILED_MSG); - morpho_defineerror(MATRIX_SETCOLARGS, ERROR_HALT, MATRIX_SETCOLARGS_MSG); - morpho_defineerror(MATRIX_NORMARGS, ERROR_HALT, MATRIX_NORMARGS_MSG); - morpho_defineerror(MATRIX_IDENTCONSTRUCTOR, ERROR_HALT, MATRIX_IDENTCONSTRUCTOR_MSG); + morpho_addfunction(MATRIX_CLASSNAME, "Matrix (Int, Int)", matrix_constructor__int_int, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(MATRIX_CLASSNAME, "Matrix (Int)", matrix_constructor__int, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(MATRIX_CLASSNAME, "Matrix (Matrix)", matrix_constructor__matrix, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(MATRIX_CLASSNAME, "Matrix (List)", matrix_constructor__list, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(MATRIX_CLASSNAME, "Matrix (Tuple)", matrix_constructor__list, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(MATRIX_CLASSNAME, "Matrix (Array)", matrix_constructor__array, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(MATRIX_CLASSNAME, "Matrix (Sparse)", matrix_constructor__sparse, MORPHO_FN_CONSTRUCTOR, NULL); + morpho_addfunction(MATRIX_CLASSNAME, "Matrix (...)", matrix_constructor__err, MORPHO_FN_CONSTRUCTOR, NULL); + + morpho_addfunction(MATRIX_IDENTITYCONSTRUCTOR, "Matrix (Int)", matrix_identityconstructor, MORPHO_FN_CONSTRUCTOR, NULL); + + morpho_defineerror(MATRIX_CONSTRUCTOR, ERROR_HALT, MATRIX_CONSTRUCTOR_MSG); + morpho_defineerror(MATRIX_IDENTCONSTRUCTOR, ERROR_HALT, MATRIX_IDENTCONSTRUCTOR_MSG); + + complexmatrix_initialize(); } -#endif +#endif /* MORPHO_INCLUDE_LINALG */ diff --git a/src/linalg/matrix.h b/src/linalg/matrix.h index fe74a5151..072a4a247 100644 --- a/src/linalg/matrix.h +++ b/src/linalg/matrix.h @@ -29,16 +29,33 @@ #define MATRIX_LAPACK_PRESENT #endif +#ifdef MORPHO_LINALG_USE_LAPACKE +typedef lapack_complex_double linalg_complexdouble_t; +typedef lapack_int linalg_int_t; +#else +typedef __LAPACK_double_complex linalg_complexdouble_t; +typedef __LAPACK_int linalg_int_t; +#endif + #include "cmplx.h" #include "list.h" +#include "linalg.h" + +#define LINALG_MAXMATRIXDEFNS 4 + /* ------------------------------------------------------- - * Matrix objects + * Matrix object type * ------------------------------------------------------- */ extern objecttype objectmatrixtype; #define OBJECT_MATRIX objectmatrixtype +extern objecttypedefn objectmatrixdefn; + +typedef int MatrixIdx_t; // Type used for matrix indices +typedef size_t MatrixCount_t; // Type used to count total number of elements + /** Matrices are a purely numerical collection type oriented toward linear algebra. Elements are stored in column-major format, i.e. [ 1 2 ] @@ -47,8 +64,10 @@ extern objecttype objectmatrixtype; typedef struct { object obj; - unsigned int nrows; - unsigned int ncols; + MatrixIdx_t nrows; // Number of rows + MatrixIdx_t ncols; // Number of columns + MatrixIdx_t nvals; // Number of doubles per entry + MatrixCount_t nels; // Total number of entries (nrows*ncols*nvals) double *elements; double matrixdata[]; } objectmatrix; @@ -59,147 +78,230 @@ typedef struct { /** Gets the object as an matrix */ #define MORPHO_GETMATRIX(val) ((objectmatrix *) MORPHO_GETOBJECT(val)) -/** Creates a matrix object */ -objectmatrix *object_newmatrix(unsigned int nrows, unsigned int ncols, bool zero); - -/** Creates a new matrix from an array */ -objectmatrix *object_matrixfromarray(objectarray *array); - -/** Creates a new matrix from an existing matrix */ -objectmatrix *object_clonematrix(objectmatrix *array); - /** @brief Use to create static matrices on the C stack @details Intended for small matrices; Caller needs to supply a double array of size nr*nc. */ -#define MORPHO_STATICMATRIX(darray, nr, nc) { .obj.type=OBJECT_MATRIX, .obj.status=OBJECT_ISUNMANAGED, .obj.next=NULL, .elements=darray, .nrows=nr, .ncols=nc } +#define MORPHO_STATICMATRIX(darray, nr, nc) { .obj.type=OBJECT_MATRIX, .obj.status=OBJECT_ISUNMANAGED, .obj.next=NULL, .elements=darray, .nrows=nr, .ncols=nc, .nvals=1, .nels=nr*nc } /** Macro to decide if a matrix is 'small' or 'large' and hence static or dynamic allocation should be used. */ #define MATRIX_ISSMALL(m) (m->nrows*m->ncolsncols; j++) { for (int i=0; inrows; i++) { - if (!(matrix_getelement(src, i, j, &val) && + if (!(matrix_getelement(src, i, j, &val)==LINALGERR_OK && sparsedok_insert(dest, i+row0, j+col0, MORPHO_FLOAT(val)))) return false; } } @@ -288,7 +288,7 @@ bool sparsedok_copytomatrix(sparsedok *src, objectmatrix *dest, int row0, int co if (sparsedok_get(src, i, j, &entry)) { double val=0.0; if (!morpho_valuetofloat(entry, &val)) return false; - if (!matrix_setelement(dest, i+row0, j+col0, val)) return false; + if (matrix_setelement(dest, i+row0, j+col0, val)!=LINALGERR_OK) return false; } } @@ -583,7 +583,7 @@ bool sparseccs_copytomatrix(sparseccs *src, objectmatrix *dest, int row0, int co if (!sparseccs_getrowindices(src, i, &nentries, &entries)) return false; for (int j=0; jvalues[k])) return false; + if (matrix_setelement(dest, entries[j]+row0, i+col0, src->values[k]) != LINALGERR_OK) return false; k++; } } @@ -687,6 +687,39 @@ bool sparse_checkupdatedimension(int check, int *dim) { return true; } +/** Recurses into an objectlist to find the dimensions of the array and all child arrays */ +static bool _getlistdimensions(objectlist *list, unsigned int dim[], unsigned int maxdim, unsigned int *ndim) { + unsigned int m=0; + + if (maxdim==0) return false; + + /* Store the length */ + if (list->val.count>dim[0]) dim[0]=list->val.count; + + for (unsigned int i=0; ival.count; i++) { + if (MORPHO_ISLIST(list->val.data[i]) && maxdim>0) { + _getlistdimensions(MORPHO_GETLIST(list->val.data[i]), dim+1, maxdim-1, &m); + } + } + *ndim=m+1; + + return true; +} + +/** Gets a matrix element from a (potentially nested) list. */ +static bool _getlistelement(objectlist *list, unsigned int ndim, unsigned int *indx, value *val) { + value out=MORPHO_NIL; + objectlist *l=list; + for (unsigned int i=0; ival.count) { + out=l->val.data[indx[i]]; + if (i0) icol+=ncols[j]; @@ -828,7 +861,7 @@ objectsparseerror sparse_catmatrix(objectlist *in, objectmatrix **out) { objectsparseerror err=sparse_docat(in, NULL, matrix_catcopyentry, &nrows, &ncols); if (err!=SPARSE_OK) goto sparse_catmatrix_error; - new = object_newmatrix(nrows, ncols, true); + new = matrix_new(nrows, ncols, true); err=sparse_docat(in, new, matrix_catcopyentry, NULL, NULL); if (err==SPARSE_OK) *out = new; @@ -844,11 +877,50 @@ objectsparseerror sparse_catmatrix(objectlist *in, objectmatrix **out) { * Construct sparse matrices * ******************************* */ +/** Recurses into an objectarray to find the dimensions of the array and all child arrays + * @param[in] array - to search + * @param[out] dim - array of dimensions to be filled out (must be zero'd before initial call) + * @param[in] maxdim - maximum number of dimensions + * @param[out] ndim - number of dimensions of the array */ +static bool _getarraydimensions(objectarray *array, unsigned int dim[], unsigned int maxdim, unsigned int *ndim) { + unsigned int n=0, m=0; + for (n=0; nndim; n++) { + int k=MORPHO_GETINTEGERVALUE(array->data[n]); + if (k>dim[n]) dim[n]=k; + } + + if (maxdimndim) return false; + + for (unsigned int i=array->ndim; indim+array->nelements; i++) { + if (MORPHO_ISARRAY(array->data[i])) { + if (!_getarraydimensions(MORPHO_GETARRAY(array->data[i]), dim+n, maxdim-n, &m)) return false; + } + } + *ndim=n+m; + + return true; +} + +/** Looks up an array element recursively if necessary */ +static value _getarrayelement(objectarray *array, unsigned int ndim, unsigned int *indx) { + unsigned int na=array->ndim; + value out; + + if (array_getelement(array, na, indx, &out)==ARRAY_OK) { + if (ndim==na) return out; + if (MORPHO_ISARRAY(out)) { + return _getarrayelement(MORPHO_GETARRAY(out), ndim-na, indx+na); + } + } + + return MORPHO_NIL; +} + /** Create a sparse array from an array */ objectsparse *object_sparsefromarray(objectarray *array) { unsigned int dim[2] = {0,0}, ndim; - if (!matrix_getarraydimensions(array, dim, 2, &ndim)) return NULL; + if (!_getarraydimensions(array, dim, 2, &ndim)) return NULL; objectsparse *new=object_newsparse(NULL, NULL); @@ -856,7 +928,7 @@ objectsparse *object_sparsefromarray(objectarray *array) { value v[3]={MORPHO_NIL, MORPHO_NIL, MORPHO_NIL}; for (unsigned int k=0; kdok, MORPHO_GETINTEGERVALUE(v[0]), MORPHO_GETINTEGERVALUE(v[1]), v[2]); @@ -875,7 +947,7 @@ objectsparseerror object_sparsefromlist(objectlist *list, objectsparse **out) { unsigned int dim[2] = {0,0}, ndim; objectsparseerror err=SPARSE_OK; - if (!matrix_getlistdimensions(list, dim, 2, &ndim)) return SPARSE_INVLDINIT; + if (!_getlistdimensions(list, dim, 2, &ndim)) return SPARSE_INVLDINIT; objectsparse *new=object_newsparse(NULL, NULL); @@ -889,7 +961,7 @@ objectsparseerror object_sparsefromlist(objectlist *list, objectsparse **out) { value v[3]={MORPHO_NIL, MORPHO_NIL, MORPHO_NIL}; for (unsigned int k=0; kdok, MORPHO_GETINTEGERVALUE(v[0]), MORPHO_GETINTEGERVALUE(v[1]), v[2]); @@ -920,11 +992,11 @@ objectsparseerror sparse_tomatrix(objectsparse *in, objectmatrix **out) { objectmatrix *new = NULL; if (sparse_checkformat(in, SPARSE_CCS, false, false)) { - new=object_newmatrix(in->ccs.nrows, in->ccs.ncols, true); + new=matrix_new(in->ccs.nrows, in->ccs.ncols, true); if (!new) return SPARSE_FAILED; if (sparseccs_copytomatrix(&in->ccs, new, 0, 0)) err=SPARSE_OK; } else if (sparse_checkformat(in, SPARSE_DOK, false, false)) { - new=object_newmatrix(in->dok.nrows, in->dok.ncols, true); + new=matrix_new(in->dok.nrows, in->dok.ncols, true); if (!new) return SPARSE_FAILED; if (sparsedok_copytomatrix(&in->dok, new, 0, 0)) err=SPARSE_OK; } @@ -1192,7 +1264,7 @@ size_t sparse_size(objectsparse *a) { void sparse_raiseerror(vm *v, objectsparseerror err) { switch(err) { case SPARSE_OK: break; - case SPARSE_INCMPTBLDIM: morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); break; + case SPARSE_INCMPTBLDIM: morpho_runtimeerror(v, LINALG_INCOMPATIBLEMATRICES); break; case SPARSE_CONVFAILED: morpho_runtimeerror(v, SPARSE_CONVFAILEDERR); break; case SPARSE_FAILED: morpho_runtimeerror(v, SPARSE_OPFAILEDERR); break; case SPARSE_INVLDINIT: morpho_runtimeerror(v, SPARSE_INVLDARRAYINIT); break; @@ -1247,7 +1319,7 @@ value Sparse_getindex(vm *v, int nargs, value *args) { if (array_valuelisttoindices(nargs, args+1, indx)) { sparse_getelement(s, indx[0], indx[1], &out); - } else morpho_runtimeerror(v, MATRIX_INVLDINDICES); + } else morpho_runtimeerror(v, LINALG_INVLDARGS); return out; } @@ -1266,7 +1338,7 @@ value Sparse_setindex(vm *v, int nargs, value *args) { if (osize!=nsize) { morpho_resizeobject(v, (object *) s, osize, nsize); } - } else morpho_runtimeerror(v, MATRIX_INVLDINDICES); + } else morpho_runtimeerror(v, LINALG_INVLDARGS); return MORPHO_NIL; } @@ -1384,7 +1456,7 @@ value Sparse_mul(vm *v, int nargs, value *args) { if (sparse_checkformat(a, SPARSE_CCS, true, true)) { objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); - objectmatrix *out=object_newmatrix(a->ccs.nrows, b->ncols, true); + objectmatrix *out=matrix_new(a->ccs.nrows, b->ncols, true); new = (objectsparse *) out; // Munge type to ensure binding/deallocation if (out) { @@ -1427,7 +1499,7 @@ value Sparse_mulr(vm *v, int nargs, value *args) { int ncols; sparse_getdimensions(b, NULL, &ncols); - objectmatrix *new=object_newmatrix(a->nrows, ncols, true); + objectmatrix *new=matrix_new(a->nrows, ncols, true); if (new) { err=sparse_muldxs(a, b, new); @@ -1460,7 +1532,7 @@ value Sparse_divr(vm *v, int nargs, value *args) { if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); - objectmatrix *new = object_newmatrix(b->nrows, b->ncols, false); + objectmatrix *new = matrix_new(b->nrows, b->ncols, false); if (new) { size_t asize=sparse_size(a); objectsparseerror err =sparse_div(a, b, new); @@ -1586,8 +1658,8 @@ value Sparse_getcolumn(vm *v, int nargs, value *args) { morpho_bindobjects(v, 1, &out); } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); - } else morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); - } else morpho_runtimeerror(v, MATRIX_SETCOLARGS); + } else morpho_runtimeerror(v, LINALG_INDICESOUTSIDEBOUNDS); + } else morpho_runtimeerror(v, LINALG_INVLDARGS); return out; } @@ -1606,13 +1678,13 @@ value Sparse_rowindices(vm *v, int nargs, value *args) { if (sparseccs_getrowindices(&s->ccs, col, &nentries, &entries)) { objectlist *new = object_newlist(nentries, NULL); if (new) { - for (int i=0; ival.data[i]=MORPHO_INTEGER(entries[i]); + new->val.count=nentries; out=MORPHO_OBJECT(new); morpho_bindobjects(v, 1, &out); } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); } - } else morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); + } else morpho_runtimeerror(v, LINALG_INDICESOUTSIDEBOUNDS); } } @@ -1640,14 +1712,14 @@ value Sparse_setrowindices(vm *v, int nargs, value *args) { if (list_getelement(list, i, &entry) && MORPHO_ISINTEGER(entry)) { entries[i]=MORPHO_GETINTEGERVALUE(entry); - } else { morpho_runtimeerror(v, MATRIX_INVLDINDICES); return MORPHO_NIL; } + } else { morpho_runtimeerror(v, LINALG_INVLDARGS); return MORPHO_NIL; } } - + if (!sparseccs_setrowindices(&s->ccs, col, nentries, entries)) { - morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + morpho_runtimeerror(v, LINALG_INCOMPATIBLEMATRICES); } - - } else morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); + + } else morpho_runtimeerror(v, LINALG_INDICESOUTSIDEBOUNDS); } } @@ -1713,24 +1785,24 @@ value Sparse_indices(vm *v, int nargs, value *args) { } MORPHO_BEGINCLASS(Sparse) -MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Sparse_getindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Sparse_setindex, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Sparse_enumerate, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_PRINT_METHOD, Sparse_print, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_ADD_METHOD, Sparse_add, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_SUB_METHOD, Sparse_sub, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_MUL_METHOD, Sparse_mul, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_MULR_METHOD, Sparse_mulr, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_DIVR_METHOD, Sparse_divr, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_TRANSPOSE_METHOD, Sparse_transpose, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_COUNT_METHOD, Sparse_count, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_DIMENSIONS_METHOD, Sparse_dimensions, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SPARSE_ROWINDICES_METHOD, Sparse_rowindices, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SPARSE_SETROWINDICES_METHOD, Sparse_setrowindices, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MATRIX_GETCOLUMN_METHOD, Sparse_getcolumn, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SPARSE_COLINDICES_METHOD, Sparse_colindices, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(MORPHO_CLONE_METHOD, Sparse_clone, BUILTIN_FLAGSEMPTY), -MORPHO_METHOD(SPARSE_INDICES_METHOD, Sparse_indices, BUILTIN_FLAGSEMPTY) +MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Sparse_getindex, MORPHO_FN_PUREFN|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Sparse_setindex, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Sparse_enumerate, MORPHO_FN_PUREFN), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Sparse_print, MORPHO_FN_IO), +MORPHO_METHOD(MORPHO_ADD_METHOD, Sparse_add, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_SUB_METHOD, Sparse_sub, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_MUL_METHOD, Sparse_mul, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_MULR_METHOD, Sparse_mulr, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_DIVR_METHOD, Sparse_divr, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MATRIX_TRANSPOSE_METHOD, Sparse_transpose, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MORPHO_COUNT_METHOD, Sparse_count, MORPHO_FN_PUREFN), +MORPHO_METHOD(MATRIX_DIMENSIONS_METHOD, Sparse_dimensions, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(SPARSE_ROWINDICES_METHOD, Sparse_rowindices, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(SPARSE_SETROWINDICES_METHOD, Sparse_setrowindices, MORPHO_FN_MUTATES|MORPHO_FN_THROWS), +MORPHO_METHOD(MATRIX_GETCOLUMN_METHOD, Sparse_getcolumn, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS), +MORPHO_METHOD(SPARSE_COLINDICES_METHOD, Sparse_colindices, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(MORPHO_CLONE_METHOD, Sparse_clone, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES), +MORPHO_METHOD(SPARSE_INDICES_METHOD, Sparse_indices, MORPHO_FN_PUREFN|MORPHO_FN_ALLOCATES|MORPHO_FN_THROWS) MORPHO_ENDCLASS /* *************************************** @@ -1741,14 +1813,14 @@ void sparse_initialize(void) { objectdokkeytype=object_addtype(&objectdokkeydefn); objectsparsetype=object_addtype(&objectsparsedefn); - builtin_addfunction(SPARSE_CLASSNAME, sparse_constructor, MORPHO_FN_CONSTRUCTOR); - objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); value sparseclass=builtin_addclass(SPARSE_CLASSNAME, MORPHO_GETCLASSDEFINITION(Sparse), objclass); object_setveneerclass(OBJECT_SPARSE, sparseclass); + builtin_addfunction(SPARSE_CLASSNAME, sparse_constructor, MORPHO_FN_CONSTRUCTOR); + morpho_defineerror(SPARSE_CONSTRUCTOR, ERROR_HALT, SPARSE_CONSTRUCTOR_MSG); morpho_defineerror(SPARSE_SETFAILED, ERROR_HALT, SPARSE_SETFAILED_MSG); morpho_defineerror(SPARSE_INVLDARRAYINIT, ERROR_HALT, SPARSE_INVLDARRAYINIT_MSG); diff --git a/src/linalg/sparse.h b/src/linalg/sparse.h index 0264cb9d8..6ec4d7da6 100644 --- a/src/linalg/sparse.h +++ b/src/linalg/sparse.h @@ -13,7 +13,7 @@ #include #include "object.h" #include "morpho.h" -#include "matrix.h" +#include "linalg.h" /* ------------------------------------------------------- * Sparse objects diff --git a/src/linalg/xmatrix.c b/src/linalg/xmatrix.c new file mode 100644 index 000000000..b71e1aed6 --- /dev/null +++ b/src/linalg/xmatrix.c @@ -0,0 +1,1585 @@ +/** @file matrix.c + * @author T J Atherton + * + * @brief Veneer class over the objectmatrix type that interfaces with blas and lapack + */ + +#include "build.h" +#ifdef MORPHO_INCLUDE_LINALG + +#include +#include "morpho.h" +#include "classes.h" + +#include "matrix.h" +#include "sparse.h" +#include "format.h" + +/* ********************************************************************** + * Matrix objects + * ********************************************************************** */ + +objecttype objectmatrixtype; + +/** Function object definitions */ +size_t objectmatrix_sizefn(object *obj) { + return sizeof(objectmatrix)+sizeof(double) * + ((objectmatrix *) obj)->ncols * + ((objectmatrix *) obj)->nrows; +} + +void objectmatrix_printfn(object *obj, void *v) { + morpho_printf(v, ""); +} + +objecttypedefn objectmatrixdefn = { + .printfn=objectmatrix_printfn, + .markfn=NULL, + .freefn=NULL, + .sizefn=objectmatrix_sizefn, + .hashfn=NULL, + .cmpfn=NULL +}; + +/** Creates a matrix object */ +objectmatrix *object_newmatrix(unsigned int nrows, unsigned int ncols, bool zero) { + unsigned int nel = nrows*ncols; + objectmatrix *new = (objectmatrix *) object_new(sizeof(objectmatrix)+nel*sizeof(double), OBJECT_MATRIX); + + if (new) { + new->ncols=ncols; + new->nrows=nrows; + new->elements=new->matrixdata; + if (zero) { + memset(new->elements, 0, sizeof(double)*nel); + } + } + + return new; +} + +/* ********************************************************************** + * Other constructors + * ********************************************************************** */ + +/* + * Create matrices from array objects + */ + +void matrix_raiseerror(vm *v, objectmatrixerror err) { + switch(err) { + case MATRIX_OK: break; + case MATRIX_INCMPTBLDIM: morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); break; + case MATRIX_SING: morpho_runtimeerror(v, MATRIX_SINGULAR); break; + case MATRIX_INVLD: morpho_runtimeerror(v, MATRIX_INVLDARRAYINIT); break; + case MATRIX_BNDS: morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); break; + case MATRIX_NSQ: morpho_runtimeerror(v, MATRIX_NOTSQ); break; + case MATRIX_FAILED: morpho_runtimeerror(v, MATRIX_OPFAILED); break; + case MATRIX_ALLOC: morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); break; + } +} + +/** Recurses into an objectarray to find the dimensions of the array and all child arrays + * @param[in] array - to search + * @param[out] dim - array of dimensions to be filled out (must be zero'd before initial call) + * @param[in] maxdim - maximum number of dimensions + * @param[out] ndim - number of dimensions of the array */ +bool matrix_getarraydimensions(objectarray *array, unsigned int dim[], unsigned int maxdim, unsigned int *ndim) { + unsigned int n=0, m=0; + for (n=0; nndim; n++) { + int k=MORPHO_GETINTEGERVALUE(array->data[n]); + if (k>dim[n]) dim[n]=k; + } + + if (maxdimndim) return false; + + for (unsigned int i=array->ndim; indim+array->nelements; i++) { + if (MORPHO_ISARRAY(array->data[i])) { + if (!matrix_getarraydimensions(MORPHO_GETARRAY(array->data[i]), dim+n, maxdim-n, &m)) return false; + } + } + *ndim=n+m; + + return true; +} + +/** Looks up an array element recursively if necessary */ +value matrix_getarrayelement(objectarray *array, unsigned int ndim, unsigned int *indx) { + unsigned int na=array->ndim; + value out; + + if (array_getelement(array, na, indx, &out)==ARRAY_OK) { + if (ndim==na) return out; + if (MORPHO_ISARRAY(out)) { + return matrix_getarrayelement(MORPHO_GETARRAY(out), ndim-na, indx+na); + } + } + + return MORPHO_NIL; +} + +/** Creates a new array from a list of values */ +objectmatrix *object_matrixfromarray(objectarray *array) { + unsigned int dim[2]={0,1}; // The 1 is to allow for vector arrays. + unsigned int ndim=0; + objectmatrix *ret=NULL; + + if (matrix_getarraydimensions(array, dim, 2, &ndim)) { + ret=object_newmatrix(dim[0], dim[1], true); + } + + unsigned int indx[2]; + if (ret) for (unsigned int i=0; ielements[j*dim[0]+i]); + } else if (!MORPHO_ISNIL(f)) { + object_free((object *) ret); return NULL; + } + } + } + + return ret; +} + +/* + * Create matrices from lists + */ + +/** Recurses into an objectlist to find the dimensions of the array and all child arrays + * @param[in] list - to search + * @param[out] dim - array of dimensions to be filled out (must be zero'd before initial call) + * @param[in] maxdim - maximum number of dimensions + * @param[out] ndim - number of dimensions of the array */ +bool matrix_getlistdimensions(objectlist *list, unsigned int dim[], unsigned int maxdim, unsigned int *ndim) { + unsigned int m=0; + + if (maxdim==0) return false; + + /* Store the length */ + if (list->val.count>dim[0]) dim[0]=list->val.count; + + for (unsigned int i=0; ival.count; i++) { + if (MORPHO_ISLIST(list->val.data[i]) && maxdim>0) { + matrix_getlistdimensions(MORPHO_GETLIST(list->val.data[i]), dim+1, maxdim-1, &m); + } + } + *ndim=m+1; + + return true; +} + +/** Gets a matrix element from a (potentially nested) list. */ +bool matrix_getlistelement(objectlist *list, unsigned int ndim, unsigned int *indx, value *val) { + value out=MORPHO_NIL; + objectlist *l=list; + for (unsigned int i=0; ival.count) { + out=l->val.data[indx[i]]; + if (i2) return false; + + unsigned int indx[2]; + if (ret) for (unsigned int i=0; ielements[j*dim[0]+i]); + } else { + object_free((object *) ret); + return NULL; + } + } + } + + return ret; +} + +/** Creates a matrix from a list of floats */ +objectmatrix *object_matrixfromfloats(unsigned int nrows, unsigned int ncols, double *list) { + objectmatrix *ret=NULL; + + ret=object_newmatrix(nrows, ncols, true); + if (ret) cblas_dcopy(ncols*nrows, list, 1, ret->elements, 1); + + return ret; +} + +/* + * Clone matrices + */ + +/** Clone a matrix */ +objectmatrix *object_clonematrix(objectmatrix *in) { + objectmatrix *new = object_newmatrix(in->nrows, in->ncols, false); + + if (new) { + cblas_dcopy(in->ncols * in->nrows, in->elements, 1, new->elements, 1); + } + + return new; +} + +/* ********************************************************************** + * Matrix operations + * ********************************************************************* */ + +/** @brief Sets a matrix element. + @returns true if the element is in the range of the matrix, false otherwise */ +bool matrix_setelement(objectmatrix *matrix, unsigned int row, unsigned int col, double value) { + if (colncols && rownrows) { + matrix->elements[col*matrix->nrows+row]=value; + return true; + } + return false; +} + +/** @brief Gets a matrix element + * @returns true if the element is in the range of the matrix, false otherwise */ +bool matrix_getelement(objectmatrix *matrix, unsigned int row, unsigned int col, double *value) { + if (colncols && rownrows) { + if (value) *value=matrix->elements[col*matrix->nrows+row]; + return true; + } + return false; +} + +/** @brief Gets a column's entries + * @param[in] matrix - the matrix + * @param[in] col - column number + * @param[out] v - column entries (matrix->nrows in number) + * @returns true if the element is in the range of the matrix, false otherwise */ +bool matrix_getcolumn(objectmatrix *matrix, unsigned int col, double **v) { + if (colncols) { + *v=&matrix->elements[col*matrix->nrows]; + return true; + } + return false; +} + +/** @brief Sets a column's entries + * @param[in] matrix - the matrix + * @param[in] col - column number + * @param[in] v - column entries (matrix->nrows in number) + * @returns true if the element is in the range of the matrix, false otherwise */ +bool matrix_setcolumn(objectmatrix *matrix, unsigned int col, double *v) { + if (colncols) { + cblas_dcopy(matrix->nrows, v, 1, &matrix->elements[col*matrix->nrows], 1); + return true; + } + return false; +} + +/** @brief Add a vector to a column in a matrix + * @param[in] m - the matrix + * @param[in] col - column number + * @param[in] alpha - scale + * @param[out] v - column entries (matrix->nrows in number) [should have m->nrows entries] + * @returns true on success */ +bool matrix_addtocolumn(objectmatrix *m, unsigned int col, double alpha, double *v) { + if (colncols) { + cblas_daxpy(m->nrows, alpha, v, 1, &m->elements[col*m->nrows], 1); + return true; + } + return false; +} + +/* ********************************************************************** + * Matrix arithmetic + * ********************************************************************* */ + +/** Copies one matrix to another */ +unsigned int matrix_countdof(objectmatrix *a) { + return a->ncols*a->nrows; +} + +/** Copies one matrix to another */ +objectmatrixerror matrix_copy(objectmatrix *a, objectmatrix *out) { + if (a->ncols==out->ncols && a->nrows==out->nrows) { + cblas_dcopy(a->ncols * a->nrows, a->elements, 1, out->elements, 1); + return MATRIX_OK; + } + return MATRIX_INCMPTBLDIM; +} + +/** Copies a matrix to another at an arbitrary point */ +objectmatrixerror matrix_copyat(objectmatrix *a, objectmatrix *out, int row0, int col0) { + if (col0+a->ncols<=out->ncols && row0+a->nrows<=out->nrows) { + for (int j=0; jncols; j++) { + for (int i=0; inrows; i++) { + double value; + if (!matrix_getelement(a, i, j, &value)) return MATRIX_BNDS; + if (!matrix_setelement(out, row0+i, col0+j, value)) return MATRIX_BNDS; + } + } + + return MATRIX_OK; + } + return MATRIX_INCMPTBLDIM; +} + +/** Performs a + b -> out. */ +objectmatrixerror matrix_add(objectmatrix *a, objectmatrix *b, objectmatrix *out) { + if (a->ncols==b->ncols && a->ncols==out->ncols && + a->nrows==b->nrows && a->nrows==out->nrows) { + if (a!=out) cblas_dcopy(a->ncols * a->nrows, a->elements, 1, out->elements, 1); + cblas_daxpy(a->ncols * a->nrows, 1.0, b->elements, 1, out->elements, 1); + return MATRIX_OK; + } + return MATRIX_INCMPTBLDIM; +} + +/** Performs lambda*a + beta -> out. */ +objectmatrixerror matrix_addscalar(objectmatrix *a, double lambda, double beta, objectmatrix *out) { + if (a->ncols==out->ncols && a->nrows==out->nrows) { + for (unsigned int i=0; inrows*out->ncols; i++) { + out->elements[i]=lambda*a->elements[i]+beta; + } + return MATRIX_OK; + } + + return MATRIX_INCMPTBLDIM; +} + +/** Performs a + lambda*b -> a. */ +objectmatrixerror matrix_accumulate(objectmatrix *a, double lambda, objectmatrix *b) { + if (a->ncols==b->ncols && a->nrows==b->nrows ) { + cblas_daxpy(a->ncols * a->nrows, lambda, b->elements, 1, a->elements, 1); + return MATRIX_OK; + } + return MATRIX_INCMPTBLDIM; +} + +/** Performs a - b -> out */ +objectmatrixerror matrix_sub(objectmatrix *a, objectmatrix *b, objectmatrix *out) { + if (a->ncols==b->ncols && a->ncols==out->ncols && + a->nrows==b->nrows && a->nrows==out->nrows) { + if (a!=out) cblas_dcopy(a->ncols * a->nrows, a->elements, 1, out->elements, 1); + cblas_daxpy(a->ncols * a->nrows, -1.0, b->elements, 1, out->elements, 1); + return MATRIX_OK; + } + return MATRIX_INCMPTBLDIM; +} + +/** Performs a * b -> out */ +objectmatrixerror matrix_mul(objectmatrix *a, objectmatrix *b, objectmatrix *out) { + if (a->ncols==b->nrows && a->nrows==out->nrows && b->ncols==out->ncols) { + cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, a->nrows, b->ncols, a->ncols, 1.0, a->elements, a->nrows, b->elements, b->nrows, 0.0, out->elements, out->nrows); + return MATRIX_OK; + } + return MATRIX_INCMPTBLDIM; +} + +/** Finds the Frobenius inner product of two matrices */ +objectmatrixerror matrix_inner(objectmatrix *a, objectmatrix *b, double *out) { + if (a->ncols==b->ncols && a->nrows==b->nrows) { + *out=cblas_ddot(a->ncols*a->nrows, a->elements, 1, b->elements, 1); + return MATRIX_OK; + } + return MATRIX_INCMPTBLDIM; +} + +/** Computes the outer product of two matrices */ +objectmatrixerror matrix_outer(objectmatrix *a, objectmatrix *b, objectmatrix *out) { + int m=a->nrows*a->ncols, n=b->nrows*b->ncols; + if (m==out->nrows && n==out->ncols) { + cblas_dger(CblasColMajor, m, n, 1, a->elements, 1, b->elements, 1, out->elements, out->nrows); + return MATRIX_OK; + } + return MATRIX_INCMPTBLDIM; +} + +/** Solves the system a.x = b + * @param[in] a lhs + * @param[in] b rhs + * @param[in] out - the solution x + * @param[out] lu - LU decomposition of a; you must provide an array the same size as a. + * @param[out] pivot - you must provide an array with the same number of rows as a. + * @returns objectmatrixerror indicating the status; MATRIX_OK indicates success. + * */ +static objectmatrixerror matrix_div(objectmatrix *a, objectmatrix *b, objectmatrix *out, double *lu, int *pivot) { + int n=a->nrows, nrhs = b->ncols, info; + + cblas_dcopy(a->ncols * a->nrows, a->elements, 1, lu, 1); + if (b!=out) cblas_dcopy(b->ncols * b->nrows, b->elements, 1, out->elements, 1); +#ifdef MORPHO_LINALG_USE_LAPACKE + info=LAPACKE_dgesv(LAPACK_COL_MAJOR, n, nrhs, lu, n, pivot, out->elements, n); +#else + dgesv_(&n, &nrhs, lu, &n, pivot, out->elements, &n, &info); +#endif + + return (info==0 ? MATRIX_OK : (info>0 ? MATRIX_SING : MATRIX_INVLD)); +} + +/** Solves the system a.x = b for small matrices (test with MATRIX_ISSMALL) + * @warning Uses the C stack for storage, which avoids malloc but can cause stack overflow */ +objectmatrixerror matrix_divs(objectmatrix *a, objectmatrix *b, objectmatrix *out) { + if (a->ncols==b->nrows && a->ncols == out->nrows) { + int pivot[a->nrows]; + double lu[a->nrows*a->ncols]; + + return matrix_div(a, b, out, lu, pivot); + } + return MATRIX_INCMPTBLDIM; +} + +/** Solves the system a.x = b for large matrices (test with MATRIX_ISSMALL) */ +objectmatrixerror matrix_divl(objectmatrix *a, objectmatrix *b, objectmatrix *out) { + objectmatrixerror ret = MATRIX_ALLOC; // Returned if allocation fails + if (!(a->ncols==b->nrows && a->ncols == out->nrows)) return MATRIX_INCMPTBLDIM; + + int *pivot=MORPHO_MALLOC(sizeof(int)*a->nrows); + double *lu=MORPHO_MALLOC(sizeof(double)*a->nrows*a->ncols); + + if (pivot && lu) ret=matrix_div(a, b, out, lu, pivot); + + if (pivot) MORPHO_FREE(pivot); + if (lu) MORPHO_FREE(lu); + + return ret; +} + +/** Inverts the matrix a + * @param[in] a lhs + * @param[in] out - the solution x + * @returns objectmatrixerror indicating the status; MATRIX_OK indicates success. + * */ +objectmatrixerror matrix_inverse(objectmatrix *a, objectmatrix *out) { + int nrows=a->nrows, ncols=a->ncols, info; + if (!(a->ncols==out->nrows && a->ncols == out->nrows)) return MATRIX_INCMPTBLDIM; + + int pivot[nrows]; + + cblas_dcopy(a->ncols * a->nrows, a->elements, 1, out->elements, 1); +#ifdef MORPHO_LINALG_USE_LAPACKE + info=LAPACKE_dgetrf(LAPACK_COL_MAJOR, nrows, ncols, out->elements, nrows, pivot); +#else + dgetrf_(&nrows, &ncols, out->elements, &nrows, pivot, &info); +#endif + + if (info!=0) return (info>0 ? MATRIX_SING : MATRIX_INVLD); + +#ifdef MORPHO_LINALG_USE_LAPACKE + info=LAPACKE_dgetri(LAPACK_COL_MAJOR, nrows, out->elements, nrows, pivot); +#else + int lwork=nrows*ncols; double work[nrows*ncols]; + dgetri_(&nrows, out->elements, &nrows, pivot, work, &lwork, &info); +#endif + + return (info==0 ? MATRIX_OK : (info>0 ? MATRIX_SING : MATRIX_INVLD)); +} + +/** Compute eigenvalues and eigenvectors of a matrix + * @param[in] a - an objectmatrix to diagonalize of size n + * @param[out] wr - a buffer of size n will hold the real part of the eigenvalues on exit + * @param[out] wi - a buffer of size n will hold the imag part of the eigenvalues on exit + * @param[out] vec - (optional) will be filled out with eigenvectors as columns (should be of size n) + * @returns an error code or MATRIX_OK on success */ +objectmatrixerror matrix_eigensystem(objectmatrix *a, double *wr, double *wi, objectmatrix *vec) { + int info, n=a->nrows; + if (a->nrows!=a->ncols) return MATRIX_NSQ; + if (vec && ((a->nrows!=vec->nrows) || (a->nrows!=vec->ncols))) return MATRIX_INCMPTBLDIM; + + // Copy a to prevent destruction + size_t size = ((size_t) n) * ((size_t) n) * sizeof(double); + double *acopy=MORPHO_MALLOC(size); + if (!acopy) return MATRIX_ALLOC; + cblas_dcopy(n*n, a->elements, 1, acopy, 1); + +#ifdef MORPHO_LINALG_USE_LAPACKE + info=LAPACKE_dgeev(LAPACK_COL_MAJOR, 'N', (vec ? 'V' : 'N'), n, acopy, n, wr, wi, NULL, n, (vec ? vec->elements : NULL), n); +#else + int lwork=4*n; double work[4*n]; + dgeev_("N", (vec ? "V" : "N"), &n, acopy, &n, wr, wi, NULL, &n, (vec ? vec->elements : NULL), &n, work, &lwork, &info); +#endif + + if (acopy) MORPHO_FREE(acopy); // Free up buffer + + if (info!=0) return (info>0 ? MATRIX_FAILED : MATRIX_INVLD); + + return MATRIX_OK; +} + + +/** Sums all elements of a matrix using Kahan summation */ +double matrix_sum(objectmatrix *a) { + unsigned int nel=a->ncols*a->nrows; + double sum=0.0, c=0.0, y,t; + + for (unsigned int i=0; ielements[i]-c; + t=sum+y; + c=(t-sum)-y; + sum=t; + } + return sum; +} + +/** Norms */ + +/** Computes the Frobenius norm of a matrix */ +double matrix_norm(objectmatrix *a) { + double nrm2=cblas_dnrm2(a->ncols*a->nrows, a->elements, 1); + return nrm2; +} + +/** Computes the L1 norm of a matrix */ +double matrix_L1norm(objectmatrix *a) { + unsigned int nel=a->ncols*a->nrows; + double sum=0.0, c=0.0, y,t; + + for (unsigned int i=0; ielements[i])-c; + t=sum+y; + c=(t-sum)-y; + sum=t; + } + return sum; +} + +/** Computes the Ln norm of a matrix */ +double matrix_Lnnorm(objectmatrix *a, double n) { + unsigned int nel=a->ncols*a->nrows; + double sum=0.0, c=0.0, y,t; + + for (unsigned int i=0; ielements[i],n)-c; + t=sum+y; + c=(t-sum)-y; + sum=t; + } + return pow(sum,1.0/n); +} + +/** Computes the Linf norm of a matrix */ +double matrix_Linfnorm(objectmatrix *a) { + unsigned int nel=a->ncols*a->nrows; + double max=0.0; + + for (unsigned int i=0; ielements[i]); + if (y>max) max=y; + } + return max; +} + +/** Transpose a matrix */ +objectmatrixerror matrix_transpose(objectmatrix *a, objectmatrix *out) { + if (!(a->ncols==out->nrows && a->nrows == out->ncols)) return MATRIX_INCMPTBLDIM; + + /* Copy elements a column at a time */ + for (unsigned int i=0; incols; i++) { + cblas_dcopy(a->nrows, a->elements+(i*a->nrows), 1, out->elements+i, a->ncols); + } + return MATRIX_OK; +} + +/** Calculate the trace of a matrix */ +objectmatrixerror matrix_trace(objectmatrix *a, double *out) { + if (a->nrows!=a->ncols) return MATRIX_NSQ; + *out=1.0; + *out=cblas_ddot(a->nrows, a->elements, a->ncols+1, out, 0); + + return MATRIX_OK; +} + +/** Scale a matrix */ +objectmatrixerror matrix_scale(objectmatrix *a, double scale) { + cblas_dscal(a->ncols*a->nrows, scale, a->elements, 1); + + return MATRIX_OK; +} + +/** Load the indentity matrix*/ +objectmatrixerror matrix_identity(objectmatrix *a) { + if (a->ncols!=a->nrows) return MATRIX_NSQ; + memset(a->elements, 0, sizeof(double)*a->nrows*a->ncols); + for (int i=0; inrows; i++) a->elements[i+a->nrows*i]=1.0; + return MATRIX_OK; +} + +/** Sets a matrix to zero */ +objectmatrixerror matrix_zero(objectmatrix *a) { + memset(a->elements, 0, sizeof(double)*a->nrows*a->ncols); + + return MATRIX_OK; +} + +/** Prints a matrix */ +void matrix_print(vm *v, objectmatrix *m) { + for (int i=0; inrows; i++) { // Rows run from 0...m + morpho_printf(v, "[ "); + for (int j=0; jncols; j++) { // Columns run from 0...k + double val; + matrix_getelement(m, i, j, &val); + morpho_printf(v, "%g ", (fabs(val)nrows-1 ? "\n" : "")); + } +} + +/** Prints a matrix to a buffer */ +bool matrix_printtobuffer(objectmatrix *m, char *format, varray_char *out) { + for (int i=0; inrows; i++) { // Rows run from 0...m + varray_charadd(out, "[ ", 2); + + for (int j=0; jncols; j++) { // Columns run from 0...k + double val; + matrix_getelement(m, i, j, &val); + if (!format_printtobuffer(MORPHO_FLOAT(val), format, out)) return false; + varray_charadd(out, " ", 1); + } + varray_charadd(out, "]", 1); + if (inrows-1) varray_charadd(out, "\n", 1); + } + return true; +} + +/** Matrix eigensystem */ +bool matrix_eigen(vm *v, objectmatrix *a, value *evals, value *evecs) { + double *ev = MORPHO_MALLOC(sizeof(double)*a->nrows*2); // Allocate temporary memory for eigenvalues + double *er=ev, *ei=ev+a->nrows; + + objectmatrix *vecs=NULL; // A new matrix for eigenvectors + objectlist *vallist = object_newlist(0, NULL); // List to hold eigenvalues + bool success=false; + + if (evecs) vecs=object_clonematrix(a); // Clones a to hold eigenvectors + + // Check that everything was allocated correctly + if (!(ev && vallist && (!evecs || vecs))) { + morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); goto matrix_eigen_cleanup; }; + + objectmatrixerror err=matrix_eigensystem(a, er, ei, vecs); + + if (err!=MATRIX_OK) { + matrix_raiseerror(v, err); + goto matrix_eigen_cleanup; + } + + // Now process the eigenvalues + for (int i=0; inrows; i++) { + if (fabs(ei[i])val.count; i++) { + if (MORPHO_ISOBJECT(vallist->val.data[i])) object_free(MORPHO_GETOBJECT(vallist->val.data[i])); + } + object_free((object *) vallist); + } + if (vecs) object_free((object *) vecs); + } + + return success; +} + +/* ********************************************************************** + * Matrix veneer class + * ********************************************************************* */ + +/** Constructs a Matrix object */ +value matrix_constructor(vm *v, int nargs, value *args) { + unsigned int nrows, ncols; + objectmatrix *new=NULL; + value out=MORPHO_NIL; + + if (nargs==2 && + MORPHO_ISINTEGER(MORPHO_GETARG(args, 0)) && + MORPHO_ISINTEGER(MORPHO_GETARG(args, 1)) ) { + nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + ncols = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); + new=object_newmatrix(nrows, ncols, true); + } else if (nargs==1 && + MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { + nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + ncols = 1; + new=object_newmatrix(nrows, ncols, true); + } else if (nargs==1 && + MORPHO_ISARRAY(MORPHO_GETARG(args, 0))) { + new=object_matrixfromarray(MORPHO_GETARRAY(MORPHO_GETARG(args, 0))); + if (!new) morpho_runtimeerror(v, MATRIX_INVLDARRAYINIT); +#ifdef MORPHO_INCLUDE_SPARSE + } else if (nargs==1 && + MORPHO_ISLIST(MORPHO_GETARG(args, 0))) { + new=object_matrixfromlist(MORPHO_GETLIST(MORPHO_GETARG(args, 0))); + if (!new) { + /** Could this be a concatenation operation? */ + objectsparseerror err = sparse_catmatrix(MORPHO_GETLIST(MORPHO_GETARG(args, 0)), &new); + if (err==SPARSE_INVLDINIT) { + morpho_runtimeerror(v, MATRIX_INVLDARRAYINIT); + } else if (err!=SPARSE_OK) sparse_raiseerror(v, err); + } +#endif + } else if (nargs==1 && + MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { + new=object_clonematrix(MORPHO_GETMATRIX(MORPHO_GETARG(args, 0))); + if (!new) morpho_runtimeerror(v, MATRIX_INVLDARRAYINIT); +#ifdef MORPHO_INCLUDE_SPARSE + } else if (nargs==1 && + MORPHO_ISSPARSE(MORPHO_GETARG(args, 0))) { + objectsparseerror err=sparse_tomatrix(MORPHO_GETSPARSE(MORPHO_GETARG(args, 0)), &new); + if (err!=SPARSE_OK) morpho_runtimeerror(v, MATRIX_INVLDARRAYINIT); +#endif + } else morpho_runtimeerror(v, MATRIX_CONSTRUCTOR); + + if (new) { + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } + + return out; +} + +/** Creates an identity matrix */ +value matrix_identityconstructor(vm *v, int nargs, value *args) { + int n; + objectmatrix *new=NULL; + value out = MORPHO_NIL; + + if (nargs==1 && + MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { + n = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + new=object_newmatrix(n, n, false); + if (new) { + matrix_identity(new); + } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + } else morpho_runtimeerror(v, MATRIX_IDENTCONSTRUCTOR); + + if (new) { + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } + + return out; +} + +/** Checks that a matrix is indexed with 2 indices with a generic interface */ +bool matrix_slicedim(value * a, unsigned int ndim){ + if (ndim>2||ndim<0) return false; + return true; +} + +/** Constucts a new matrix with a generic interface */ +void matrix_sliceconstructor(unsigned int *slicesize,unsigned int ndim,value* out){ + unsigned int numcol = 1; + if (ndim == 2) { + numcol = slicesize[1]; + } + *out = MORPHO_OBJECT(object_newmatrix(slicesize[0],numcol,false)); +} +/** Copies data from a at indx to out at newindx with a generic interface */ +objectarrayerror matrix_slicecopy(value * a,value * out, unsigned int ndim, unsigned int *indx,unsigned int *newindx){ + double num; // matrices store doubles; + unsigned int colindx = 0; + unsigned int colnewindx = 0; + + if (ndim == 2) { + colindx = indx[1]; + colnewindx = newindx[1]; + } + + if (!(matrix_getelement(MORPHO_GETMATRIX(*a),indx[0],colindx,&num)&& + matrix_setelement(MORPHO_GETMATRIX(*out),newindx[0],colnewindx,num))){ + return ARRAY_OUTOFBOUNDS; + } + return ARRAY_OK; +} + +/** Rolls the matrix list */ +void matrix_rollflat(objectmatrix *a, objectmatrix *b, int nplaces) { + unsigned int N = a->nrows*a->ncols; + int n = abs(nplaces); + if (n>N) n = n % N; + unsigned int Np = N - n; // Number of elements to roll + + if (nplaces<0) { + memcpy(b->matrixdata, a->matrixdata+n, sizeof(double)*Np); + memcpy(b->matrixdata+Np, a->matrixdata, sizeof(double)*n); + } else { + memcpy(b->matrixdata+n, a->matrixdata, sizeof(double)*Np); + if (n>0) memcpy(b->matrixdata, a->matrixdata+Np, sizeof(double)*n); + } +} + +/** Copies arow from matrix a into brow for matrix b */ +void matrix_copyrow(objectmatrix *a, int arow, objectmatrix *b, int brow) { + cblas_dcopy(a->ncols, a->elements+arow, a->nrows, b->elements+brow, a->nrows); +} + +/** Rolls a list by a number of elements */ +objectmatrix *matrix_roll(objectmatrix *a, int nplaces, int axis) { + objectmatrix *new=object_newmatrix(a->nrows, a->ncols, false); + + if (new) { + switch(axis) { + case 0: { // TODO: Could probably be faster + for (int i=0; inrows; i++) { + int j = (i+nplaces); + if (j<0) j+=a->nrows; + matrix_copyrow(a, i, new, j % a->nrows); + } + } + break; + case 1: matrix_rollflat(a, new, nplaces*a->nrows); break; + } + } + + return new; +} + +/** Gets the matrix element with given indices */ +value Matrix_getindex(vm *v, int nargs, value *args) { + objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); + unsigned int indx[2]={0,0}; + value out = MORPHO_NIL; + if (nargs>2){ + morpho_runtimeerror(v, MATRIX_INVLDNUMINDICES); + return out; + } + + if (array_valuelisttoindices(nargs, args+1, indx)) { + double outval; + if (!matrix_getelement(m, indx[0], indx[1], &outval)) { + morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); + } else { + out = MORPHO_FLOAT(outval); + } + } else { // now try to get a slice + objectarrayerror err = getslice(&MORPHO_SELF(args), &matrix_slicedim, &matrix_sliceconstructor, &matrix_slicecopy, nargs, &MORPHO_GETARG(args,0), &out); + if (err!=ARRAY_OK) MORPHO_RAISE(v, array_to_matrix_error(err) ); + if (MORPHO_ISOBJECT(out)){ + morpho_bindobjects(v,1,&out); + } else morpho_runtimeerror(v, MATRIX_INVLDINDICES); + } + return out; +} + +/** Sets the matrix element with given indices */ +value Matrix_setindex(vm *v, int nargs, value *args) { + objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); + unsigned int indx[2]={0,0}; + + if (array_valuelisttoindices(nargs-1, args+1, indx)) { + double value=0.0; + if (MORPHO_ISFLOAT(args[nargs])) value=MORPHO_GETFLOATVALUE(args[nargs]); + if (MORPHO_ISINTEGER(args[nargs])) value=(double) MORPHO_GETINTEGERVALUE(args[nargs]); + + if (!matrix_setelement(m, indx[0], indx[1], value)) { + morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); + } + } else morpho_runtimeerror(v, MATRIX_INVLDINDICES); + + return MORPHO_NIL; +} + +/** Sets the column of a matrix */ +value Matrix_setcolumn(vm *v, int nargs, value *args) { + objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); + + if (nargs==2 && + MORPHO_ISINTEGER(MORPHO_GETARG(args, 0)) && + MORPHO_ISMATRIX(MORPHO_GETARG(args, 1))) { + unsigned int col = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + objectmatrix *src = MORPHO_GETMATRIX(MORPHO_GETARG(args, 1)); + + if (colncols) { + if (src && src->ncols*src->nrows==m->nrows) { + matrix_setcolumn(m, col, src->elements); + } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + } else morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); + } else morpho_runtimeerror(v, MATRIX_SETCOLARGS); + + return MORPHO_NIL; +} + +/** Gets a column of a matrix */ +value Matrix_getcolumn(vm *v, int nargs, value *args) { + objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==1 && + MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { + unsigned int col = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + if (colncols) { + double *vals; + if (matrix_getcolumn(m, col, &vals)) { + objectmatrix *new=object_matrixfromfloats(m->nrows, 1, vals); + if (new) { + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } + } + } else morpho_runtimeerror(v, MATRIX_INDICESOUTSIDEBOUNDS); + } else morpho_runtimeerror(v, MATRIX_SETCOLARGS); + + return out; +} + +/** Prints a matrix */ +value Matrix_print(vm *v, int nargs, value *args) { + value self = MORPHO_SELF(args); + if (!MORPHO_ISMATRIX(self)) return Object_print(v, nargs, args); + + objectmatrix *m=MORPHO_GETMATRIX(MORPHO_SELF(args)); + matrix_print(v, m); + return MORPHO_NIL; +} + +/** Formatted conversion to a string */ +value Matrix_format(vm *v, int nargs, value *args) { + value out = MORPHO_NIL; + + if (nargs==1 && + MORPHO_ISSTRING(MORPHO_GETARG(args, 0))) { + varray_char str; + varray_charinit(&str); + + if (matrix_printtobuffer(MORPHO_GETMATRIX(MORPHO_SELF(args)), + MORPHO_GETCSTRING(MORPHO_GETARG(args, 0)), + &str)) { + out = object_stringfromvarraychar(&str); + if (MORPHO_ISOBJECT(out)) morpho_bindobjects(v, 1, &out); + } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + + varray_charclear(&str); + } else { + morpho_runtimeerror(v, VALUE_FRMTARG); + } + + return out; +} + +/** Matrix add */ +value Matrix_assign(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + + if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + + if (a->ncols==b->ncols && a->nrows==b->nrows) { + matrix_copy(b, a); + } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + } + + return MORPHO_NIL; +} + +/** Matrix add */ +value Matrix_add(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + + if (a->ncols==b->ncols && a->nrows==b->nrows) { + objectmatrix *new = object_newmatrix(a->nrows, a->ncols, false); + if (new) { + out=MORPHO_OBJECT(new); + matrix_add(a, b, new); + } + } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + double val; + if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { + objectmatrix *new = object_newmatrix(a->nrows, a->ncols, false); + if (new) { + out=MORPHO_OBJECT(new); + matrix_addscalar(a, 1.0, val, new); + } + } + } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + + if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); + + return out; +} + +/** Right add */ +value Matrix_addr(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==1 && (MORPHO_ISNIL(MORPHO_GETARG(args, 0)) || + MORPHO_ISNUMBER(MORPHO_GETARG(args, 0)))) { + int i=0; + if (MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) i=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + if (MORPHO_ISFLOAT(MORPHO_GETARG(args, 0))) i=(fabs(MORPHO_GETFLOATVALUE(MORPHO_GETARG(args, 0)))ncols==b->ncols && a->nrows==b->nrows) { + objectmatrix *new = object_newmatrix(a->nrows, a->ncols, false); + if (new) { + out=MORPHO_OBJECT(new); + matrix_sub(a, b, new); + } + } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + double val; + if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &val)) { + objectmatrix *new = object_newmatrix(a->nrows, a->ncols, false); + if (new) { + out=MORPHO_OBJECT(new); + matrix_addscalar(a, 1.0, -val, new); + } + } + } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + + if (!MORPHO_ISNIL(out)) morpho_bindobjects(v, 1, &out); + + return out; +} + +/** Right subtract */ +value Matrix_subr(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==1 && (MORPHO_ISNIL(MORPHO_GETARG(args, 0)) || + MORPHO_ISNUMBER(MORPHO_GETARG(args, 0)))) { + int i=(MORPHO_ISNIL(MORPHO_GETARG(args, 0)) ? 0 : MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0))); + + if (MORPHO_ISFLOAT(MORPHO_GETARG(args, 0))) i=(fabs(MORPHO_GETFLOATVALUE(MORPHO_GETARG(args, 0)))nrows, a->ncols, false); + if (new) { + matrix_addscalar(a, 1.0, -val, new); + // now that did self - arg[0] and we want arg[0] - self so scale the whole thing by -1 + matrix_scale(new, -1.0); + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } + } + + } else morpho_runtimeerror(v, VM_INVALIDARGS); + } else morpho_runtimeerror(v, VM_INVALIDARGS); + + return out; +} + +/** Matrix multiply */ +value Matrix_mul(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + + if (a->ncols==b->nrows) { + objectmatrix *new = object_newmatrix(a->nrows, b->ncols, false); + if (new) { + out=MORPHO_OBJECT(new); + matrix_mul(a, b, new); + morpho_bindobjects(v, 1, &out); + } + } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + double scale=1.0; + if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &scale)) { + objectmatrix *new = object_clonematrix(a); + if (new) { + out=MORPHO_OBJECT(new); + matrix_scale(new, scale); + morpho_bindobjects(v, 1, &out); + } + } +#ifdef MORPHO_INCLUDE_SPARSE + } else if (nargs==1 && MORPHO_ISSPARSE(MORPHO_GETARG(args, 0))) { + // Returns nil to ensure it gets passed to mulr on Sparse +#endif + } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + + return out; +} + +/** Called when multiplying on the right */ +value Matrix_mulr(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + double scale=1.0; + if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &scale)) { + objectmatrix *new = object_clonematrix(a); + if (new) { + out=MORPHO_OBJECT(new); + matrix_scale(new, scale); + morpho_bindobjects(v, 1, &out); + } + } + } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + + return out; +} + +/** Solution of linear system a.x = b (i.e. x = b/a) */ +value Matrix_div(vm *v, int nargs, value *args) { + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + + if (a->ncols==b->nrows) { + objectmatrix *new = object_newmatrix(b->nrows, b->ncols, false); + if (new) { + objectmatrixerror err; + if (MATRIX_ISSMALL(a)) { + err=matrix_divs(a, b, new); + } else { + err=matrix_divl(a, b, new); + } + if (err==MATRIX_SING) { + morpho_runtimeerror(v, MATRIX_SINGULAR); + object_free((object *) new); + } else { + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } + } + } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); +#ifdef MORPHO_INCLUDE_SPARSE + } else if (nargs==1 && MORPHO_ISSPARSE(MORPHO_GETARG(args, 0))) { + /* Division by a sparse matrix: redirect to the divr selector of Sparse. */ + value vargs[2]={args[1],args[0]}; + return Sparse_divr(v, nargs, vargs); +#endif + } else if (nargs==1 && MORPHO_ISNUMBER(MORPHO_GETARG(args, 0))) { + /* Division by a scalar */ + double scale=1.0; + if (morpho_valuetofloat(MORPHO_GETARG(args, 0), &scale)) { + if (fabs(scale)ncols==b->ncols && a->nrows==b->nrows) { + out=MORPHO_SELF(args); + double lambda=1.0; + morpho_valuetofloat(MORPHO_GETARG(args, 0), &lambda); + matrix_accumulate(a, lambda, b); + } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + + return MORPHO_NIL; +} + +/** Frobenius inner product */ +value Matrix_inner(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + + double prod=0.0; + if (matrix_inner(a, b, &prod)==MATRIX_OK) { + out = MORPHO_FLOAT(prod); + } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + + return out; +} + +/** Outer product */ +value Matrix_outer(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==1 && MORPHO_ISMATRIX(MORPHO_GETARG(args, 0))) { + objectmatrix *b=MORPHO_GETMATRIX(MORPHO_GETARG(args, 0)); + objectmatrix *new=object_newmatrix(a->nrows*a->ncols, b->nrows*b->ncols, true); + + if (new && + matrix_outer(a, b, new)==MATRIX_OK) { + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + } else morpho_runtimeerror(v, MATRIX_ARITHARGS); + + return out; +} + +/** Matrix sum */ +value Matrix_sum(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + return MORPHO_FLOAT(matrix_sum(a)); +} + +/** Roll a matrix */ +value Matrix_roll(vm *v, int nargs, value *args) { + objectmatrix *slf = MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out = MORPHO_NIL; + int roll, axis=0; + + if (nargs>0 && + morpho_valuetoint(MORPHO_GETARG(args, 0), &roll)) { + + if (nargs==2 && !morpho_valuetoint(MORPHO_GETARG(args, 1), &axis)) return out; + + objectmatrix *new = matrix_roll(slf, roll, axis); + + if (new) { + out = MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } + + } else morpho_runtimeerror(v, LIST_ADDARGS); + + return out; +} + + +/** Matrix norm */ +value Matrix_norm(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out = MORPHO_NIL; + + if (nargs==1) { + value arg = MORPHO_GETARG(args, 0); + + if (MORPHO_ISNUMBER(arg)) { + double n; + + if (morpho_valuetofloat(arg, &n)) { + if (fabs(n-1.0)val.count, new->val.data); + new->val.count--; // And pop it back off + } + + return evals; +} + +/** Matrix eigensystem */ +value Matrix_eigensystem(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value evals=MORPHO_NIL, evecs=MORPHO_NIL, out=MORPHO_NIL; + objectlist *resultlist = object_newlist(0, NULL); + if (!resultlist) { + morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + return MORPHO_NIL; + } + + if (matrix_eigen(v, a, &evals, &evecs)) { + objectlist *evallist = MORPHO_GETLIST(evals); + + list_append(resultlist, evals); // Create the output list + list_append(resultlist, evecs); + out=MORPHO_OBJECT(resultlist); + + list_append(evallist, evals); // Ensure we bind all objects at once + list_append(evallist, evecs); // by popping them onto the evallist. + list_append(evallist, out); // + morpho_bindobjects(v, evallist->val.count, evallist->val.data); + evallist->val.count-=3; // and then popping them back off. + } + + return out; +} + +/** Inverts a matrix */ +value Matrix_inverse(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + // The inverse will have the number of rows and number of columns + // swapped. + objectmatrix *new = object_newmatrix(a->ncols, a->nrows, false); + if (new) { + objectmatrixerror mi = matrix_inverse(a, new); + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + + if (mi!=MATRIX_OK) matrix_raiseerror(v, mi); + } + + return out; +} + +/** Transpose of a matrix */ +value Matrix_transpose(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + objectmatrix *new = object_newmatrix(a->ncols, a->nrows, false); + if (new) { + matrix_transpose(a, new); + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } + + return out; +} + +/** Reshape a matrix */ +value Matrix_reshape(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + + if (nargs==2 && + MORPHO_ISINTEGER(MORPHO_GETARG(args, 0)) && + MORPHO_ISINTEGER(MORPHO_GETARG(args, 1))) { + int nrows = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + int ncols = MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 1)); + + if (nrows*ncols==a->nrows*a->ncols) { + a->nrows=nrows; + a->ncols=ncols; + } else morpho_runtimeerror(v, MATRIX_INCOMPATIBLEMATRICES); + } else morpho_runtimeerror(v, MATRIX_RESHAPEARGS); + + return MORPHO_NIL; +} + +/** Trace of a matrix */ +value Matrix_trace(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (a->nrows==a->ncols) { + double tr; + if (matrix_trace(a, &tr)==MATRIX_OK) out=MORPHO_FLOAT(tr); + } else { + morpho_runtimeerror(v, MATRIX_NOTSQ); + } + + return out; +} + +/** Enumerate protocol */ +value Matrix_enumerate(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value out=MORPHO_NIL; + + if (nargs==1) { + if (MORPHO_ISINTEGER(MORPHO_GETARG(args, 0))) { + int i=MORPHO_GETINTEGERVALUE(MORPHO_GETARG(args, 0)); + + if (i<0) out=MORPHO_INTEGER(a->ncols*a->nrows); + else if (incols*a->nrows) out=MORPHO_FLOAT(a->elements[i]); + } + } + + return out; +} + + +/** Number of matrix elements */ +value Matrix_count(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + + return MORPHO_INTEGER(a->ncols*a->nrows); +} + +/** Matrix dimensions */ +value Matrix_dimensions(vm *v, int nargs, value *args) { + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + value dim[2]; + value out=MORPHO_NIL; + + dim[0]=MORPHO_INTEGER(a->nrows); + dim[1]=MORPHO_INTEGER(a->ncols); + + objectlist *new=object_newlist(2, dim); + if (new) { + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + + return out; +} + +/** Clones a matrix */ +value Matrix_clone(vm *v, int nargs, value *args) { + value out=MORPHO_NIL; + objectmatrix *a=MORPHO_GETMATRIX(MORPHO_SELF(args)); + objectmatrix *new=object_clonematrix(a); + if (new) { + out=MORPHO_OBJECT(new); + morpho_bindobjects(v, 1, &out); + } else morpho_runtimeerror(v, ERROR_ALLOCATIONFAILED); + return out; +} + +MORPHO_BEGINCLASS(Matrix) +MORPHO_METHOD(MORPHO_GETINDEX_METHOD, Matrix_getindex, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_SETINDEX_METHOD, Matrix_setindex, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_GETCOLUMN_METHOD, Matrix_getcolumn, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_SETCOLUMN_METHOD, Matrix_setcolumn, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_PRINT_METHOD, Matrix_print, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_FORMAT_METHOD, Matrix_format, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_ASSIGN_METHOD, Matrix_assign, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD_SIGNATURE(MORPHO_ADD_METHOD, "Matrix (_)", Matrix_add, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD_SIGNATURE(MORPHO_ADDR_METHOD, "Matrix (_)", Matrix_addr, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD_SIGNATURE(MORPHO_SUB_METHOD, "Matrix (_)", Matrix_sub, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD_SIGNATURE(MORPHO_SUBR_METHOD, "Matrix (_)", Matrix_subr, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_MUL_METHOD, Matrix_mul, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_MULR_METHOD, Matrix_mulr, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_DIV_METHOD, Matrix_div, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_ACC_METHOD, Matrix_acc, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_INNER_METHOD, Matrix_inner, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_OUTER_METHOD, Matrix_outer, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_SUM_METHOD, Matrix_sum, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_NORM_METHOD, Matrix_norm, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_INVERSE_METHOD, Matrix_inverse, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_TRANSPOSE_METHOD, Matrix_transpose, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_RESHAPE_METHOD, Matrix_reshape, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_EIGENVALUES_METHOD, Matrix_eigenvalues, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_EIGENSYSTEM_METHOD, Matrix_eigensystem, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_TRACE_METHOD, Matrix_trace, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_ENUMERATE_METHOD, Matrix_enumerate, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_COUNT_METHOD, Matrix_count, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MATRIX_DIMENSIONS_METHOD, Matrix_dimensions, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_ROLL_METHOD, Matrix_roll, BUILTIN_FLAGSEMPTY), +MORPHO_METHOD(MORPHO_CLONE_METHOD, Matrix_clone, BUILTIN_FLAGSEMPTY) +MORPHO_ENDCLASS + +/* ********************************************************************** + * Initialization + * ********************************************************************* */ + +void matrix_initialize(void) { + objectmatrixtype=object_addtype(&objectmatrixdefn); + + builtin_addfunction(MATRIX_CLASSNAME, matrix_constructor, MORPHO_FN_CONSTRUCTOR); + builtin_addfunction(MATRIX_IDENTITYCONSTRUCTOR, matrix_identityconstructor, BUILTIN_FLAGSEMPTY); + + objectstring objname = MORPHO_STATICSTRING(OBJECT_CLASSNAME); + value objclass = builtin_findclass(MORPHO_OBJECT(&objname)); + + value matrixclass=builtin_addclass(MATRIX_CLASSNAME, MORPHO_GETCLASSDEFINITION(Matrix), objclass); + object_setveneerclass(OBJECT_MATRIX, matrixclass); + + morpho_defineerror(MATRIX_INDICESOUTSIDEBOUNDS, ERROR_HALT, MATRIX_INDICESOUTSIDEBOUNDS_MSG); + morpho_defineerror(MATRIX_INVLDINDICES, ERROR_HALT, MATRIX_INVLDINDICES_MSG); + morpho_defineerror(MATRIX_INVLDNUMINDICES, ERROR_HALT, MATRIX_INVLDNUMINDICES_MSG); + morpho_defineerror(MATRIX_CONSTRUCTOR, ERROR_HALT, MATRIX_CONSTRUCTOR_MSG); + morpho_defineerror(MATRIX_INVLDARRAYINIT, ERROR_HALT, MATRIX_INVLDARRAYINIT_MSG); + morpho_defineerror(MATRIX_ARITHARGS, ERROR_HALT, MATRIX_ARITHARGS_MSG); + morpho_defineerror(MATRIX_RESHAPEARGS, ERROR_HALT, MATRIX_RESHAPEARGS_MSG); + morpho_defineerror(MATRIX_INCOMPATIBLEMATRICES, ERROR_HALT, MATRIX_INCOMPATIBLEMATRICES_MSG); + morpho_defineerror(MATRIX_SINGULAR, ERROR_HALT, MATRIX_SINGULAR_MSG); + morpho_defineerror(MATRIX_NOTSQ, ERROR_HALT, MATRIX_NOTSQ_MSG); + morpho_defineerror(MATRIX_OPFAILED, ERROR_HALT, MATRIX_OPFAILED_MSG); + morpho_defineerror(MATRIX_SETCOLARGS, ERROR_HALT, MATRIX_SETCOLARGS_MSG); + morpho_defineerror(MATRIX_NORMARGS, ERROR_HALT, MATRIX_NORMARGS_MSG); + morpho_defineerror(MATRIX_IDENTCONSTRUCTOR, ERROR_HALT, MATRIX_IDENTCONSTRUCTOR_MSG); +} + +#endif diff --git a/src/linalg/xmatrix.h b/src/linalg/xmatrix.h new file mode 100644 index 000000000..fe74a5151 --- /dev/null +++ b/src/linalg/xmatrix.h @@ -0,0 +1,205 @@ +/** @file matrix.h + * @author T J Atherton + * + * @brief Veneer class over the objectmatrix type that interfaces with blas and lapack + */ + +#ifndef matrix_h +#define matrix_h + +#include "build.h" +#ifdef MORPHO_INCLUDE_LINALG + +#include +#include "classes.h" +/** Use Apple's Accelerate library for LAPACK and BLAS */ +#ifdef __APPLE__ +#ifdef MORPHO_LINALG_USE_ACCELERATE +#define ACCELERATE_NEW_LAPACK +#include +#define MATRIX_LAPACK_PRESENT +#endif +#endif + +/** Otherwise, use LAPACKE */ +#ifndef MATRIX_LAPACK_PRESENT +#include +#include +#define MORPHO_LINALG_USE_LAPACKE +#define MATRIX_LAPACK_PRESENT +#endif + +#include "cmplx.h" +#include "list.h" + +/* ------------------------------------------------------- + * Matrix objects + * ------------------------------------------------------- */ + +extern objecttype objectmatrixtype; +#define OBJECT_MATRIX objectmatrixtype + +/** Matrices are a purely numerical collection type oriented toward linear algebra. + Elements are stored in column-major format, i.e. + [ 1 2 ] + [ 3 4 ] + is stored ( 1, 3, 2, 4 ) in memory. This is for compatibility with standard linear algebra packages */ + +typedef struct { + object obj; + unsigned int nrows; + unsigned int ncols; + double *elements; + double matrixdata[]; +} objectmatrix; + +/** Tests whether an object is a matrix */ +#define MORPHO_ISMATRIX(val) object_istype(val, OBJECT_MATRIX) + +/** Gets the object as an matrix */ +#define MORPHO_GETMATRIX(val) ((objectmatrix *) MORPHO_GETOBJECT(val)) + +/** Creates a matrix object */ +objectmatrix *object_newmatrix(unsigned int nrows, unsigned int ncols, bool zero); + +/** Creates a new matrix from an array */ +objectmatrix *object_matrixfromarray(objectarray *array); + +/** Creates a new matrix from an existing matrix */ +objectmatrix *object_clonematrix(objectmatrix *array); + +/** @brief Use to create static matrices on the C stack + @details Intended for small matrices; Caller needs to supply a double array of size nr*nc. */ +#define MORPHO_STATICMATRIX(darray, nr, nc) { .obj.type=OBJECT_MATRIX, .obj.status=OBJECT_ISUNMANAGED, .obj.next=NULL, .elements=darray, .nrows=nr, .ncols=nc } + +/** Macro to decide if a matrix is 'small' or 'large' and hence static or dynamic allocation should be used. */ +#define MATRIX_ISSMALL(m) (m->nrows*m->ncolsclasstable)); bool success=extension_call(e, MORPHO_GETCSTRING(e->name), MORPHO_EXTENSIONINITIALIZE); + if (success) success=builtin_parsesignatures(); + if (success) success=builtin_finalizemetafunctions(); builtin_setfunctiontable(ofunc); builtin_setclasstable(oclss); - - return success; + + return success; } /** Call the extension's finalizer */ diff --git a/src/support/help.c b/src/support/help.c new file mode 100644 index 000000000..f205259be --- /dev/null +++ b/src/support/help.c @@ -0,0 +1,1458 @@ +/** @file help.c + * @author T J Atherton + * + * @brief Morpho help +*/ + +#include +#include +#include +#include +#include +#include + +#include "classes.h" +#include "help.h" +#include "resources.h" +#include "common.h" +#include "dictionary.h" +#include "list.h" + +#include "error.h" +#include "lex.h" +#include "parse.h" +#include "file.h" +#include "memory.h" + +#ifdef MORPHO_INCLUDE_HELP + +/* ********************************************************************** + * Data structures and static data + * ********************************************************************** */ + +DEFINE_VARRAY(md_block, md_block); +DEFINE_VARRAY(md_file, md_file); +DEFINE_VARRAY(md_topic, md_topic); + +static varray_md_file s_files; +static varray_md_topic s_topics; +static dictionary s_names; /* name (interned on build) -> topic index or list of indices */ + +/** The interactive help system uses a collection of Markdown files, located in + * MORPHO_HELPFOLDER, that define available topics. Help files are all + * valid Markdown, although only a subset is used, and the help system interprets + * Markdown syntax in special ways: + * + * Headers defined with #, ##, etc are used to identify discrete topics. + * Successive levels of header are used to create subtopics. + * + * Link definitions are used to include metadata: + * + * [tag]: # () is used to define additional synonyms for the topic. + * + * The help system also recognizes code blocks etc. */ + +/* ********************************************************************** + * Markdown lexer + * ********************************************************************** + * Token table is sorted for longest-match (e.g. ### before ## before #). + * The preprocessor captures any run of characters that does not match a + * defined token as a single MD_TEXT token. Whitespace is not skipped, + * so newlines and indentation are visible to the parser. */ + +enum { + MD_TEXT, + MD_HASH, + MD_HASH2, + MD_HASH3, + MD_COLON, + MD_LEFTPAREN, + MD_RIGHTPAREN, + MD_LEFTSQUAREBRACE, + MD_RIGHTSQUAREBRACE, + MD_BACKTICK, + MD_ASTERISK, + MD_PLUS, + MD_DASH, + MD_UNDERSCORE, + MD_ASTERISK2, + MD_UNDERSCORE2, + MD_ASTERISK3, + MD_UNDERSCORE3, + MD_THEMATIC_BREAK, + MD_FOURSPACES, + MD_TAB, + MD_NEWLINE, + MD_EOF +}; + +bool md_lexnewline(lexer *l, token *tok, error *err) { + lex_newline(l); + return true; +} + + +tokendefn mdtokens[] = { + { "#", MD_HASH , NULL }, + { "##", MD_HASH2 , NULL }, + { "###", MD_HASH3 , NULL }, + { ":", MD_COLON , NULL }, + { "(", MD_LEFTPAREN , NULL }, + { ")", MD_RIGHTPAREN , NULL }, + { "[", MD_LEFTSQUAREBRACE , NULL }, + { "]", MD_RIGHTSQUAREBRACE , NULL }, + { "`", MD_BACKTICK , NULL }, + { "*", MD_ASTERISK , NULL }, + { "+", MD_PLUS , NULL }, + { "-", MD_DASH , NULL }, + { "_", MD_UNDERSCORE , NULL }, + { "**", MD_ASTERISK2 , NULL }, + { "__", MD_UNDERSCORE2 , NULL }, + { "***", MD_ASTERISK3 , NULL }, + { "___", MD_UNDERSCORE3 , NULL }, + { " ", MD_FOURSPACES , NULL }, + { "\t", MD_TAB , NULL }, + { "\r\n", MD_NEWLINE , md_lexnewline }, + { "\n", MD_NEWLINE , md_lexnewline }, + { "\r", MD_NEWLINE , md_lexnewline }, + { "", TOKEN_NONE , NULL } +}; + +/** Check if a character is ASCII punctuation (CommonMark spec 2.4: escapable with backslash). */ +static bool md_isasciipunct(char c) { + return (unsigned char)c <= 0x7F && ispunct((unsigned char)c); +} + +/** Check if current position is a thematic break and record it as MD_THEMATIC_BREAK token. + * Returns true if a thematic break token was recorded, false otherwise. */ +static bool md_lexthematicbreak(lexer *l, token *tok) { + char c = lex_peek(l); + if (c != '-' && c != '*' && c != '_') return false; + + int count = 0; // Count consecutive matching characters using peekahead (must be 3+) + while (lex_peekahead(l, count) == c && count < 100) count++; // reasonable limit + if (count < 3) return false; + + int spaces = 0; // Check for optional spaces after break characters + while (lex_peekahead(l, count + spaces) == ' ') spaces++; + + char next = lex_peekahead(l, count + spaces); // Must be followed by newline or EOF + if (next != '\n' && next != '\r' && next != '\0') return false; + + size_t total_len = (size_t)count + (size_t)spaces; // Calculate total length to advance + if (next == '\r' && lex_peekahead(l, count + spaces + 1) == '\n') { + total_len += 2; // \r\n + } else if (next == '\n' || next == '\r') { + total_len += 1; // \n or \r + } + + lex_advanceby(l, total_len); // Advance by total length and record token + lex_recordtoken(l, MD_THEMATIC_BREAK, tok); + return true; +} + +/** Lexer token preprocessor function */ +bool md_lexpreprocess(lexer *l, token *tok, error *err) { + if (md_lexthematicbreak(l, tok)) return true; // Check for thematic break before processing other tokens + + while (!lex_identifytoken(l, false, NULL) && !lex_isatend(l)) { + char c = lex_peek(l); + if (c == '\\') { + char next = lex_peekahead(l, 1); + if (md_isasciipunct(next)) { + lex_advance(l); // Skip \ and include punctuation as literal + lex_advance(l); + continue; + } else if (next == '\n' || next == '\r' || next == '\0') { + lex_advance(l); // Skip \; newline will be tokenized as MD_NEWLINE in next iteration + continue; + } + // Backslash before non-punctuation: include \ as literal + } + lex_advance(l); + } + if (l->current > l->start) { + lex_recordtoken(l, MD_TEXT, tok); + return true; + } + return false; +} + +/* ------------------------------------------------------- + * Lexer initialization + * ------------------------------------------------------- */ + +void help_initializemdlexer(lexer *l, const char *src) { + lex_init(l, src, 0); + lex_settokendefns(l, mdtokens); + lex_setprefn(l, md_lexpreprocess); + lex_setwhitespacefn(l, NULL); + lex_seteof(l, MD_EOF); +} + +/* ------------------------------------------------------- + * Markdown parse table (for inline syntax) + * ------------------------------------------------------- */ + +/** Parses inline code span. Content is ignored until closing backtick. */ +bool md_parseinlinecode(parser *p, void *out) { + while (!parse_checktoken(p, MD_BACKTICK) && !parse_checktoken(p, MD_EOF)) + parse_advance(p); + if (!parse_checktokenadvance(p, MD_BACKTICK)) { + parse_error(p, false, MD_UNCLOSEDINLINECODE); + return false; + } + return true; +} + +bool md_parsebold(parser *p, void *out) { + while (parse_checktokenadvance(p, MD_TEXT)); + if (parse_checktoken(p, MD_ASTERISK2) || + parse_checktoken(p, MD_UNDERSCORE2)) parse_advance(p); + return true; +} + +/** Parses italic: called after consuming opening * or _; consumes TEXT then closing delimiter. */ +bool md_parseitalic(parser *p, void *out) { + tokentype delim = p->previous.type; // MD_ASTERISK or MD_UNDERSCORE + while (parse_checktokenadvance(p, MD_TEXT)); + if (!parse_checktokenadvance(p, delim)) { + parse_error(p, false, MD_UNCLOSEDITALIC); + return false; + } + return true; +} + +parserule md_rules[] = { + PARSERULE_PREFIX(MD_ASTERISK, md_parseitalic ), + PARSERULE_PREFIX(MD_UNDERSCORE, md_parseitalic ), + PARSERULE_PREFIX(MD_ASTERISK2, md_parsebold ), + PARSERULE_PREFIX(MD_UNDERSCORE2, md_parsebold ), + PARSERULE_PREFIX(MD_BACKTICK, md_parseinlinecode ), + PARSERULE_UNUSED(TOKEN_NONE) +}; + +/* ------------------------------------------------------- + * Parse output: build AST (blocks + topic list) + * ------------------------------------------------------- */ + +/** Output context for the parser: current file, topic list, and base for span offsets. */ +typedef struct { + md_file *file; + varray_md_topic *topics; + int file_index; + int current_header_level; // 1–3, set before md_parseheader + int current_topic_index; // Index of most recently created topic, or -1 +} md_parseout; + +typedef struct { + char qbuf[MORPHO_MAX_HELPQUERY_LENGTH]; + const char *segs[MORPHO_HELP_QUERY_MAXSEGMENTS]; + int nsegs; +} help_queryparts; + +/* Forward declarations */ +static void md_push_simpleblock(parser *p, md_parseout *out, size_t block_start, md_blocktype type); +static void md_push_blank(parser *p, md_parseout *out); + +static void md_push_header(parser *p, md_parseout *out, size_t block_start, size_t title_start, size_t title_len); +static void md_push_paragraph(parser *p, md_parseout *out, size_t block_start); +static void md_push_code(parser *p, md_parseout *out, size_t block_start); +static void md_push_list(parser *p, md_parseout *out, size_t block_start); +static void md_push_link(parser *p, md_parseout *out, size_t block_start, size_t label_start, size_t label_len, size_t target_start, size_t target_len); +static bool help_istopleveltopic(unsigned int i); +static int help_topicdepth(int idx); +static bool help_nameindex_get(const char *name, value *out); +static int help_parsequery(const char *query, help_queryparts *parts); +static int help_resolvetopic(const help_queryparts *query); +static void help_appendothertopics(const char *name, int preferred, varray_char *result); + +/** Span from the token we just consumed (p->previous). */ +static md_span md_span_previous(parser *p, const char *base) { + md_span s; + s.start = (size_t)(p->previous.start - base); + s.length = p->previous.length; + return s; +} + +/** End position of the token we just consumed. */ +static size_t md_end_previous(parser *p, const char *base) { + return (size_t)(p->previous.start - base) + p->previous.length; +} + +/** Clamp span length to fit within source length. Returns clamped length. */ +static size_t md_clamp_span(size_t start, size_t len, size_t src_len) { + if (start >= src_len) return 0; + if (start + len > src_len) return src_len - start; + return len; +} + +/* ------------------------------------------------------- + * Markdown parse rules + * ------------------------------------------------------- */ + +/** Consume newline or require EOF; return true if valid line end. */ +static bool md_parselineend(parser *p) { + if (parse_checktoken(p, MD_NEWLINE)) return parse_advance(p); + return parse_checktoken(p, MD_EOF); +} + +/** Check if a token type is a 'textual' token (incl. * _ for italic, ** __ for bold, ` for code) */ +tokentype _inlinetokens[] = { + MD_TEXT, MD_COLON, MD_BACKTICK, MD_LEFTPAREN, MD_RIGHTPAREN, + MD_ASTERISK, MD_UNDERSCORE, MD_ASTERISK2, MD_UNDERSCORE2 +}; +int _ninlinetokens = sizeof(_inlinetokens)/sizeof(tokentype); + +/** Token types that can appear literally in paragraph/list text (consumed without inline rules). */ +tokentype _literalintext[] = { + MD_HASH, MD_HASH2, MD_HASH3, MD_LEFTSQUAREBRACE, MD_RIGHTSQUAREBRACE, + MD_FOURSPACES, MD_TAB, MD_PLUS, MD_DASH +}; +int _nliteralintext = sizeof(_literalintext)/sizeof(tokentype); + +/** True if current token can be consumed as text (MD_TEXT or inline formatting tokens). */ +bool md_checktexttoken(parser *p) { + return parse_checktokenmulti(p, _ninlinetokens, _inlinetokens); +} + +/** True if current token can be consumed as literal in paragraph/list (no prefix rule). */ +static bool md_checkliteralintext(parser *p) { + return parse_checktokenmulti(p, _nliteralintext, _literalintext); +} + +/** Consume text content tokens (MD_TEXT and literal tokens like - : etc.). + * If apply_inline_rules is true, applies inline formatting rules (bold/italic/code) to MD_TEXT tokens. + * Returns true if we should continue consuming (more text/literal available), false if we hit non-text/non-literal. */ +static bool md_consumetextcontent(parser *p, bool apply_inline_rules, void *out) { + if (md_checktexttoken(p)) { + parse_advance(p); + if (apply_inline_rules) { + parserule *rule = parse_getrule(p, p->previous.type); + if (rule && rule->prefix && !rule->prefix(p, out)) return false; + } + return true; + } else if (md_checkliteralintext(p)) { + parse_advance(p); + return true; + } + return false; +} + +/** Parses text written in markdown; stops at a non-textual token. Line ends with NEWLINE or EOF. */ +bool md_parsetext(parser *p, void *out) { + md_parseout *ctx = (md_parseout *) out; + const char *base = ctx->file->source; + size_t block_start = (size_t)(p->current.start - base); + + for (;;) { + while (md_consumetextcontent(p, true, out)); + if (md_parselineend(p)) break; + parse_error(p, true, MD_EXPECTLINEEND); + return false; + } + md_push_paragraph(p, ctx, block_start); + return true; +} + +/** Parses a markdown header (title then newline or EOF). Accepts MD_TEXT and literal tokens (e.g. - for hyphen) for the title. */ +bool md_parseheader(parser *p, void *out) { + md_parseout *ctx = (md_parseout *) out; + const char *base = ctx->file->source; + size_t block_start = (size_t)(p->previous.start - base); // # token already consumed + + if (!parse_checktokenadvance(p, MD_TEXT)) { + parse_error(p, false, MD_EXPECTHEADERTEXT); + return false; + } + size_t title_start = (size_t)(p->previous.start - base); + size_t title_len = p->previous.length; + while (md_consumetextcontent(p, false, out)) { + title_len = (size_t)((p->previous.start - base) + p->previous.length - title_start); + } + + if (!md_parselineend(p)) { + parse_error(p, true, MD_EXPECTLINEEND); + return false; + } + md_push_header(p, ctx, block_start, title_start, title_len); + return true; +} + +/** Parses markdown code block (indented lines until newline or EOF). */ +bool md_parsecode(parser *p, void *out) { + md_parseout *ctx = (md_parseout *) out; + size_t block_start = (size_t)(p->previous.start - ctx->file->source); // 4 spaces / tab already consumed + + while (!parse_checktoken(p, MD_NEWLINE) && !parse_checktoken(p, MD_EOF)) parse_advance(p); + if (!md_parselineend(p)) { + parse_error(p, true, MD_EXPECTLINEEND); + return false; + } + md_push_code(p, ctx, block_start); + return true; +} + +/** Parses a thematic break (---, ***, or ___). Token already consumed by lexer (includes newline). */ +static bool md_parsethematicbreak(parser *p, void *out) { + md_parseout *ctx = (md_parseout *) out; + const char *base = ctx->file->source; + size_t block_start = (size_t)(p->previous.start - base); + md_push_simpleblock(p, ctx, block_start, MD_BLOCK_THEMATIC_BREAK); + return true; +} + +/** Parses a markdown list (list item line; records as list block). */ +bool md_parselist(parser *p, void *out) { + md_parseout *ctx = (md_parseout *) out; + const char *base = ctx->file->source; + size_t block_start = (size_t)(p->previous.start - base); // *, +, or - already consumed + + for (;;) { + while (md_consumetextcontent(p, true, out)); + if (md_parselineend(p)) break; + parse_error(p, true, MD_EXPECTLINEEND); + return false; + } + md_push_list(p, ctx, block_start); + return true; +} + +/** Parses the rest of a link definition after ]: (e.g. " # (target)" or " # (subtopics)"). Consumes until newline or EOF. + * Extracts target URL and any parenthesized content. Returns target_start, target_len, paren_start, paren_len via pointers. + * paren_start/len are set to 0 if no parentheses found. */ +static void md_parseurl(parser *p, void *out, size_t *target_start, size_t *target_len, size_t *paren_start, size_t *paren_len) { + md_parseout *ctx = (md_parseout *) out; + const char *base = ctx->file->source; + *target_start = (size_t)(p->current.start - base); + *paren_start = 0; + *paren_len = 0; + + // Parse tokens until we hit MD_LEFTPAREN (for parenthesized content) or MD_NEWLINE/EOF + size_t target_end = *target_start; + while (!parse_checktoken(p, MD_LEFTPAREN) && !parse_checktoken(p, MD_NEWLINE) && !parse_checktoken(p, MD_EOF)) { + parse_advance(p); + target_end = md_end_previous(p, base); + } + // target_end is now the end of the last token before MD_LEFTPAREN (or MD_NEWLINE/EOF) + *target_len = target_end > *target_start ? (size_t)(target_end - *target_start) : 0; + + // If we found a left parenthesis, extract parenthesized content + if (parse_checktokenadvance(p, MD_LEFTPAREN)) { + *paren_start = (size_t)(p->current.start - base); + // Parse content until right parenthesis + while (!parse_checktoken(p, MD_RIGHTPAREN) && !parse_checktoken(p, MD_NEWLINE) && !parse_checktoken(p, MD_EOF)) parse_advance(p); + if (parse_checktokenadvance(p, MD_RIGHTPAREN)) { // paren_len is content between ( and ), excluding the closing ) + *paren_len = (size_t)(p->previous.start - base - *paren_start); + } else { // Unmatched parenthesis, ignore + *paren_start = 0; *paren_len = 0; + } + } + + // Consume newline if present + parse_checktokenadvance(p, MD_NEWLINE); +} + +/** Parses inline link [text](url)... after [ and label and ] are consumed. Consumes ( url ) and rest of line, pushes paragraph. */ +static bool md_parseinlinelink(parser *p, void *out, size_t block_start) { + md_parseout *ctx = (md_parseout *) out; + parse_advance(p); // consume ( + while (!parse_checktoken(p, MD_RIGHTPAREN) && !parse_checktoken(p, MD_NEWLINE) && !parse_checktoken(p, MD_EOF)) + parse_advance(p); + if (!parse_checktokenadvance(p, MD_RIGHTPAREN)) { + parse_error(p, false, MD_LINKEXPECTBRACKET); + return false; + } + while (!parse_checktoken(p, MD_NEWLINE) && !parse_checktoken(p, MD_EOF)) + parse_advance(p); // consume rest of line (e.g. trailing ".") + if (!md_parselineend(p)) { + parse_error(p, true, MD_EXPECTLINEEND); + return false; + } + md_push_paragraph(p, ctx, block_start); + return true; +} + +static bool help_createalias(const char *base, size_t label_start, size_t label_len, size_t paren_start, size_t paren_len, int topic_index); + +/** Case-insensitive comparison of substring (s, n) with literal (lit, lit_len). */ +static bool help_casencmp(const char *s, size_t n, const char *lit, size_t lit_len) { + if (n != lit_len) return false; + for (size_t i = 0; i < n; i++) + if (tolower((unsigned char) s[i]) != (unsigned char) lit[i]) return false; + return true; +} + +/** Parses [label]: target (link def) or [text](url) an inline link. Caller has already consumed [. */ +bool md_parselink(parser *p, void *out) { + md_parseout *ctx = (md_parseout *) out; + const char *base = ctx->file->source; + size_t block_start = (size_t)(p->previous.start - base); + + if (!parse_checktokenadvance(p, MD_TEXT)) { // Parse label text + parse_error(p, false, MD_LINKEXPECTTEXT); + return false; + } + size_t label_start = (size_t)(p->previous.start - base); + size_t label_len = p->previous.length; + + if (!parse_checktokenadvance(p, MD_RIGHTSQUAREBRACE)) { // Parse closing ] + parse_error(p, false, MD_LINKEXPECTBRACKET); + return false; + } + if (parse_checktoken(p, MD_LEFTPAREN)) return md_parseinlinelink(p, out, block_start); // Inline link [text](url) + + if (!parse_checktokenadvance(p, MD_COLON)) { // Parse : for link definition + parse_error(p, false, MD_LINKEXPECTCOLON); + return false; + } + size_t target_start, target_len, paren_start, paren_len; + md_parseurl(p, out, &target_start, &target_len, &paren_start, &paren_len); + + // Check for special directives: [show]: # (subtopics) or [toplevel]: # + // Accept both [show] and [showsubtopics] (case-insensitive prefix match) + if (label_len >= 4 && help_casencmp(base + label_start, 4, "show", 4) && paren_len > 0 && help_casencmp(base + paren_start, paren_len, "subtopics", 9)) { + md_push_simpleblock(p, ctx, block_start, MD_SHOW_SUBTOPICS); + return true; + } else if (help_casencmp(base + label_start, label_len, "toplevel", 8)) { + ctx->file->promote_subtopics = true; + return true; + } + + // Normal reference link: create alias/link block + help_createalias(base, label_start, label_len, paren_start, paren_len, ctx->current_topic_index); + md_push_link(p, ctx, block_start, label_start, label_len, target_start, target_len); + return true; +} + +/** Parse a markdown 'block' */ +bool md_parseblock(parser *p, void *out) { + md_parseout *ctx = (md_parseout *) out; + // Dispatch by first token. Check block-start alternatives first. + if (parse_checktokenadvance(p, MD_HASH)) { + ctx->current_header_level = 1; + return md_parseheader(p, out); + } else if (parse_checktokenadvance(p, MD_HASH2)) { + ctx->current_header_level = 2; + return md_parseheader(p, out); + } else if (parse_checktokenadvance(p, MD_HASH3)) { + ctx->current_header_level = 3; + return md_parseheader(p, out); + } else if (parse_checktokenadvance(p, MD_FOURSPACES) || + parse_checktokenadvance(p, MD_TAB)) { + return md_parsecode(p, out); + } else if (parse_checktokenadvance(p, MD_THEMATIC_BREAK)) { + return md_parsethematicbreak(p, out); + } else if (parse_checktoken(p, MD_ASTERISK) || + parse_checktoken(p, MD_PLUS) || + parse_checktoken(p, MD_DASH)) { + // CommonMark: list marker must be followed by space or tab; else treat as paragraph. + char c = lex_peek(p->lex); + if (c == ' ' || c == '\t') { + parse_advance(p); + return md_parselist(p, out); + } + return md_parsetext(p, out); + } else if (parse_checktokenadvance(p, MD_LEFTSQUAREBRACE)) { + return md_parselink(p, out); + } else if (parse_checktokenadvance(p, MD_NEWLINE)) { // blank line + md_push_blank(p, ctx); + return true; + } else if (parse_checktoken(p, MD_EOF)) { + return true; // let outer loop exit + } else if (md_checktexttoken(p)) { + return md_parsetext(p, out); + } else { + parse_error(p, false, MD_UNEXPECTEDTOKEN); + return false; + } +} + +/** Base markdown parse type */ +bool md_parse(parser *p, void *out) { + while (!parse_checktoken(p, MD_EOF)) { + PARSE_CHECK(md_parseblock(p, out)); + } + + return true; +} + +/* ------------------------------------------------------- + * Initialize a Markdown parser + * ------------------------------------------------------- */ + +/** Initializes a parser to parse Markdown (help format). */ +void help_initializemdparser(parser *p, lexer *l, error *err, void *out) { + parse_init(p, l, err, out); + parse_setbaseparsefn(p, md_parse); + parse_setparsetable(p, md_rules); + parse_setskipnewline(p, false, TOKEN_NONE); +} + +/* ********************************************************************** + * Markdown AST: block and file life cycle + * ********************************************************************** */ + +void md_block_clear(md_block *b) { + varray_intclear(&b->children); +} + +void md_file_init(md_file *f) { + f->source = NULL; + f->sourcelen = 0; + f->filename = NULL; + f->promote_subtopics = false; + varray_md_blockinit(&f->blocks); +} + +void md_file_clear(md_file *f) { + if (f->source) MORPHO_FREE(f->source); + f->source = NULL; + f->sourcelen = 0; + if (f->filename) MORPHO_FREE(f->filename); + f->filename = NULL; + for (unsigned int i = 0; i < f->blocks.count; i++) md_block_clear(&f->blocks.data[i]); + varray_md_blockclear(&f->blocks); +} + +/* ------------------------------------------------------- + * Name index (single dict: name/alias -> index or List of indices) + * ------------------------------------------------------- */ + +static bool help_namereferencedby(value name, unsigned int keep_count) { + for (unsigned int j = 0; j < keep_count; j++) + if (MORPHO_ISSAME(s_topics.data[j].name, name)) return true; + return false; +} + +/** Remove topic_index from s_names (rollback). Frees the name key only if the entry is removed and no topic in [0, keep_count) has that name. */ +static void help_nameindex_remove(int topic_index, unsigned int keep_count) { + if (topic_index < 0 || (unsigned int) topic_index >= s_topics.count) return; + value name = s_topics.data[topic_index].name; + if (!MORPHO_ISOBJECT(name)) return; + value v; + if (!dictionary_get(&s_names, name, &v)) return; + bool remove_entry = false; + if (MORPHO_ISINTEGER(v)) { + if (MORPHO_GETINTEGERVALUE(v) != topic_index) return; + remove_entry = true; + } else if (MORPHO_ISLIST(v)) { + list_remove(MORPHO_GETLIST(v), MORPHO_INTEGER(topic_index)); + remove_entry = (list_length(MORPHO_GETLIST(v)) == 0); + } + if (remove_entry) { + if (MORPHO_ISLIST(v)) morpho_freeobject(v); + dictionary_remove(&s_names, name); + if (!help_namereferencedby(name, keep_count)) morpho_freeobject(name); + } +} + +static bool help_nameindex_get(const char *name, value *out) { + objectstring key_str = MORPHO_STATICSTRING(name); + value key = MORPHO_OBJECT(&key_str); + return dictionary_get(&s_names, key, out); +} + +/** Add topic_index under name (buf, len). Look up with static key; if present use existing key and update value, else allocate and insert. Returns canonical name value. */ +static value help_nameindex_add(const char *buf, size_t len, int topic_index) { + objectstring key_obj = MORPHO_STATICSTRINGWITHLENGTH(buf, len); + value name = MORPHO_OBJECT(&key_obj), v; + value key = dictionary_getkey(&s_names, name, &v); + if (MORPHO_ISNIL(key)) { + key = object_stringfromcstring(buf, len); + if (!MORPHO_ISSTRING(key)) return MORPHO_NIL; + if (!dictionary_insert(&s_names, key, MORPHO_INTEGER(topic_index))) { + morpho_freeobject(key); + return MORPHO_NIL; + } + } else { + if (MORPHO_ISNIL(v)) { + dictionary_insert(&s_names, key, MORPHO_INTEGER(topic_index)); + } else if (MORPHO_ISINTEGER(v)) { + if (MORPHO_GETINTEGERVALUE(v) == topic_index) return key; + value new[2] = { v, MORPHO_INTEGER(topic_index) }; + objectlist *list = object_newlist(2, new); + if (list) { + if (!dictionary_insert(&s_names, key, MORPHO_OBJECT(list))) + morpho_freeobject(MORPHO_OBJECT(list)); + } + } else if (MORPHO_ISLIST(v)) { + objectlist *list = MORPHO_GETLIST(v); + value topic = MORPHO_INTEGER(topic_index); + if (!list_find(list, topic, NULL)) list_append(list, topic); + } + } + return key; +} + +/** Get first topic index from dict value (integer or first element of list). Returns -1 if not found or invalid. */ +static int help_firstindex(value v) { + if (MORPHO_ISINTEGER(v)) return MORPHO_GETINTEGERVALUE(v); + if (MORPHO_ISLIST(v)) { + objectlist *list = MORPHO_GETLIST(v); + if (list_length(list) == 0) return -1; + value first; + if (list_getelement(list, 0, &first) && MORPHO_ISINTEGER(first)) + return MORPHO_GETINTEGERVALUE(first); + } + return -1; +} + +/** Fill indices[] from dict value (integer or list). Returns number of indices written (at most max). */ +static int help_collectindices(value v, int indices[], int max) { + if (MORPHO_ISINTEGER(v)) { + if (max > 0) indices[0] = MORPHO_GETINTEGERVALUE(v); + return 1; + } else if (MORPHO_ISLIST(v)) { + objectlist *list = MORPHO_GETLIST(v); + unsigned int list_len = list_length(list); + int written = 0; + for (unsigned int i = 0; i < list_len && written < max; i++) { + value el; + if (list_getelement(list, (int) i, &el) && MORPHO_ISINTEGER(el)) { + indices[written++] = MORPHO_GETINTEGERVALUE(el); + } + } + return written; + } + return 0; +} + +int help_findtopic(const char *name) { + int cand[MORPHO_HELP_MAX_MULTIMATCH]; + int n = help_findallbyname(name, cand, MORPHO_HELP_MAX_MULTIMATCH); + if (n <= 0) return -1; + + int preferred = cand[0]; + int bestdepth = help_topicdepth(preferred); + bool ambiguous = false; + + for (int i = 1; i < n; i++) { + int depth = help_topicdepth(cand[i]); + if (depth < bestdepth) { + bestdepth = depth; + preferred = cand[i]; + ambiguous = false; + } else if (depth == bestdepth) { + ambiguous = true; + } + } + + return ambiguous ? cand[0] : preferred; +} + +int help_findallbyname(const char *name, int indices[], int max) { + value v; + if (!help_nameindex_get(name, &v)) return 0; + return help_collectindices(v, indices, max); +} + +static int help_topicdepth(int idx) { + int depth = 0; + + while (idx >= 0 && (unsigned int) idx < s_topics.count) { + idx = s_topics.data[idx].parent_topic; + if (idx >= 0) depth++; + } + + return depth; +} + +/** Find child of parent topic with given name. Returns topic index or -1. Uses s_names then filters by parent. */ +static int help_findchild(int parent_idx, const char *name) { + int cand[MORPHO_HELP_MAX_MULTIMATCH]; + int n = help_findallbyname(name, cand, MORPHO_HELP_MAX_MULTIMATCH); + for (int i = 0; i < n; i++) + if (s_topics.data[cand[i]].parent_topic == parent_idx) return cand[i]; + return -1; +} + +/* ------------------------------------------------------- + * Block construction (spans, init, push) + * ------------------------------------------------------- */ + +/** End offset of the block from the last consumed token. */ +static size_t md_block_end(parser *p, const char *base) { + return md_end_previous(p, base); +} + +/** Set a span to (start, length). */ +static void md_span_set(md_span *s, size_t start, size_t length) { + s->start = start; + s->length = length; +} + +/** Trim leading and trailing whitespace from (start, len) in place. */ +static void md_trimspan(const char *base, size_t *start, size_t *len) { + while (*len && (unsigned char) base[*start] <= ' ') { (*start)++; (*len)--; } + while (*len && (unsigned char) base[*start + *len - 1] <= ' ') (*len)--; +} + +/** Lowercase len bytes from src into buf and null-terminate. Caller must provide buf of size at least len + 1. */ +static void help_lowercase_into(const char *src, size_t len, char *buf) { + for (size_t i = 0; i < len; i++) buf[i] = (char) tolower((unsigned char) src[i]); + buf[len] = '\0'; +} + +/** Initialize common block fields (type, span, parent, children). */ +static void md_block_init(md_block *b, md_blocktype type, size_t block_start, size_t block_end) { + b->type = type; + md_span_set(&b->span, block_start, block_end - block_start); + b->parent = -1; + varray_intinit(&b->children); +} + +/** Set header block fields (level and title span). */ +static void md_block_set_header(md_block *b, int level, size_t title_start, size_t title_len) { + b->as.header.level = level; + md_span_set(&b->as.header.title, title_start, title_len); +} + +/** Set link-def block fields (label and target spans). */ +static void md_block_set_link_def(md_block *b, size_t label_start, size_t label_len, size_t target_start, size_t target_len) { + md_span_set(&b->as.link_def.label, label_start, label_len); + md_span_set(&b->as.link_def.target, target_start, target_len); +} + +/** Push a simple block (paragraph, code, list); type and span only. */ +static void md_push_simpleblock(parser *p, md_parseout *out, size_t block_start, md_blocktype type) { + const char *base = out->file->source; + md_block b; + md_block_init(&b, type, block_start, md_block_end(p, base)); + varray_md_blockwrite(&out->file->blocks, b); +} + +static void md_push_header(parser *p, md_parseout *out, size_t block_start, size_t title_start, size_t title_len) { + const char *base = out->file->source; + size_t block_end = md_block_end(p, base); + + md_block b; + md_block_init(&b, MD_BLOCK_HEADER, block_start, block_end); + md_block_set_header(&b, out->current_header_level, title_start, title_len); + varray_md_blockwrite(&out->file->blocks, b); + + // Topic: trimmed title span, lowercased Morpho string (stack buffer) + size_t ns = title_start, nl = title_len; + md_trimspan(base, &ns, &nl); + if (nl > MORPHO_MAX_HELPQUERY_LENGTH) { + out->current_topic_index = -1; + return; + } + char buf[nl + 1]; + help_lowercase_into(base + ns, nl, buf); + int topic_index = (int) out->topics->count; + value name = help_nameindex_add(buf, nl, topic_index); + if (MORPHO_ISNIL(name)) { + out->current_topic_index = -1; + return; + } + md_topic topic = { + .name = name, + .file_index = out->file_index, + .block_index = out->file->blocks.count - 1, + .level = out->current_header_level, + .parent_topic = -1 + }; + varray_md_topicwrite(out->topics, topic); + out->current_topic_index = topic_index; +} + +static void md_push_paragraph(parser *p, md_parseout *out, size_t block_start) { + md_push_simpleblock(p, out, block_start, MD_BLOCK_PARAGRAPH); +} +static void md_push_code(parser *p, md_parseout *out, size_t block_start) { + md_push_simpleblock(p, out, block_start, MD_BLOCK_CODE); +} +static void md_push_list(parser *p, md_parseout *out, size_t block_start) { + md_push_simpleblock(p, out, block_start, MD_BLOCK_LIST); +} + +/** Push a blank line as MD_BLOCK_BLANK. Call after consuming the newline token. */ +static void md_push_blank(parser *p, md_parseout *out) { + const char *base = out->file->source; + size_t block_start = (size_t)(p->previous.start - base); + md_push_simpleblock(p, out, block_start, MD_BLOCK_BLANK); +} + +static void md_push_link(parser *p, md_parseout *out, size_t block_start, size_t label_start, size_t label_len, size_t target_start, size_t target_len) { + const char *base = out->file->source; + size_t block_end = md_block_end(p, base); + md_block b; + md_block_init(&b, MD_BLOCK_LINK_DEF, block_start, block_end); + md_block_set_link_def(&b, label_start, label_len, target_start, target_len); + varray_md_blockwrite(&out->file->blocks, b); +} + +/* ********************************************************************** + * Help topic aliases + * ********************************************************************** */ + +/** Create an alias from a tag link definition. Inserts alias -> topic index into s_names. + * Alias text is the parenthesized part from the URL (e.g. [tagvar]: # (var) -> "var"). Requires paren_len > 0. */ +static bool help_createalias(const char *base, size_t label_start, size_t label_len, size_t paren_start, size_t paren_len, int topic_index) { + if (topic_index < 0 || (unsigned int) topic_index >= s_topics.count) return false; + if (label_len < 3 || !help_casencmp(base + label_start, 3, "tag", 3)) return false; + if (paren_len == 0 || paren_len > MORPHO_MAX_HELPQUERY_LENGTH) return false; + char alias_buf[paren_len + 1]; + help_lowercase_into(base + paren_start, paren_len, alias_buf); + return !MORPHO_ISNIL(help_nameindex_add(alias_buf, paren_len, topic_index)); +} + +/* ********************************************************************** + * Help topic lookup and content range + * ********************************************************************** */ + +/** Edit distance return when string too long (no match). */ +#define MORPHO_HELP_EDIT_NOMATCH 255 + +/* ------------------------------------------------------- + * Query parsing + * ------------------------------------------------------- */ + +/** Parse query into lowercased segments in qbuf; segs[] points into qbuf. Returns nsegs (0 if none). */ +static int help_parsequery(const char *query, help_queryparts *parts) { + char *qbuf = parts->qbuf; + const char **segs = parts->segs; + + // Copy query, lowercase, replace '.' and ' ' with nul + size_t qlen = 0; + while (query[qlen] && qlen < MORPHO_MAX_HELPQUERY_LENGTH - 1) { + char c = query[qlen]; + qbuf[qlen] = (c == '.' || c == ' ') ? '\0' : (char) tolower((unsigned char) c); + qlen++; + } + qbuf[qlen] = '\0'; + // Collect segment start pointers (skip nuls, take runs) + int nsegs = 0; + const char *p = qbuf; + while (nsegs < MORPHO_HELP_QUERY_MAXSEGMENTS && p < qbuf + qlen) { + while (p < qbuf + qlen && *p == '\0') p++; + if (p >= qbuf + qlen) break; + segs[nsegs++] = p; + while (p < qbuf + qlen && *p != '\0') p++; + } + parts->nsegs = nsegs; + return nsegs; +} + +/* ------------------------------------------------------- + * Topic hierarchy (parent, display path, subtopic) + * ------------------------------------------------------- */ + +/** Find parent topic index (same file, level < current, block_index < current, largest block_index). */ +static int help_findparent(int idx) { + if (idx < 0 || (unsigned int) idx >= s_topics.count) return -1; + const md_topic *t = &s_topics.data[idx]; + int level = t->level; + if (level <= 1) return -1; + // Same file, strictly earlier block, lower level; keep one with largest block_index + int parent = -1; + unsigned int best_block = 0; + for (unsigned int i = 0; i < s_topics.count; i++) { + if (s_topics.data[i].file_index != t->file_index) continue; + if (s_topics.data[i].level >= level) continue; + if (s_topics.data[i].block_index >= t->block_index) continue; + if (parent < 0 || s_topics.data[i].block_index > best_block) { + parent = (int) i; + best_block = s_topics.data[i].block_index; + } + } + return parent; +} + +/** Write full display path for topic (e.g. "System.clock") into buf. */ +static void help_displaypath(int idx, char *buf, size_t bufsize) { + if (!bufsize) return; + if (idx < 0 || (unsigned int) idx >= s_topics.count) { + buf[0] = '\0'; + return; + } + const md_topic *t = &s_topics.data[idx]; + const char *name = MORPHO_ISSTRING(t->name) ? MORPHO_GETCSTRING(t->name) : NULL; + if (!name) { + buf[0] = '\0'; + return; + } + int p = t->parent_topic; + if (p >= 0) { + help_displaypath(p, buf, bufsize); + size_t len = strlen(buf); + if (len + 1 < bufsize) snprintf(buf + len, bufsize - len, ".%s", name); + } else { + snprintf(buf, bufsize, "%s", name); + } +} + +static int help_resolvetopic(const help_queryparts *query) { + if (query->nsegs <= 0) return -1; + + int idx = help_findtopic(query->segs[0]); + if (idx < 0) return -1; + + for (int i = 1; i < query->nsegs; i++) { + idx = help_findchild(idx, query->segs[i]); + if (idx < 0) return -1; + } + + return idx; +} + +/* ------------------------------------------------------- + * Edit distance and suggestions + * ------------------------------------------------------- */ + +/** Levenshtein distance between two strings (for "did you mean"). + * If max_dist is provided (> 0), returns early if distance exceeds it (returns max_dist + 1). + * This allows early exit when we only care about distances within a threshold. */ +static unsigned int help_editdistance(const char *a, const char *b, unsigned int max_dist) { + size_t na = strlen(a), nb = strlen(b); + if (na == 0) return (unsigned int) nb; + if (nb == 0) return (unsigned int) na; + if (na > MORPHO_HELP_EDITMAXLEN || nb > MORPHO_HELP_EDITMAXLEN) return MORPHO_HELP_EDIT_NOMATCH; + + // Early exit: if length difference exceeds max_dist, distance must be at least that + size_t len_diff = (na > nb) ? na - nb : nb - na; + if (max_dist > 0 && len_diff > max_dist) return max_dist + 1; + + // Two-row DP: prev row and current row, swap each iteration + unsigned int row0[MORPHO_HELP_EDITMAXLEN + 1], row1[MORPHO_HELP_EDITMAXLEN + 1]; + unsigned int *prev = row0, *curr = row1; + for (size_t j = 0; j <= nb; j++) prev[j] = (unsigned int) j; + for (size_t i = 1; i <= na; i++) { + curr[0] = (unsigned int) i; + for (size_t j = 1; j <= nb; j++) { + unsigned int cost = (tolower((unsigned char) a[i - 1]) == tolower((unsigned char) b[j - 1])) ? 0 : 1; + unsigned int del = prev[j] + 1, ins = curr[j - 1] + 1, sub = prev[j - 1] + cost; + unsigned int min = (del < ins) ? del : ins; + curr[j] = (min < sub) ? min : sub; + } + // Early exit: if the final column (curr[nb]) exceeds max_dist, we can stop + if (max_dist > 0 && curr[nb] > max_dist) return max_dist + 1; + { unsigned int *t = prev; prev = curr; curr = t; } + } + return prev[nb]; +} + +/** Find topic name closest to name. If parent_idx >= 0, only consider subtopics of that parent; otherwise search all topics. Returns NULL if no topics to compare. */ +static const char *help_findclosesttopic(const char *name, int parent_idx) { + const char *best = NULL; + int best_d = -1; /* no candidate yet */ + size_t len = strlen(name); + for (unsigned int j = 0; j < s_topics.count; j++) { + if (parent_idx >= 0 && s_topics.data[j].parent_topic != parent_idx) continue; + if (!MORPHO_ISSTRING(s_topics.data[j].name)) continue; + const char *tn = MORPHO_GETCSTRING(s_topics.data[j].name); + int d = help_editdistance(name, tn, (unsigned int) len); + if (d < best_d || best_d < 0) { best_d = d; best = tn; } + } + return best; +} + +/* ------------------------------------------------------- + * Topic content and rendering + * ------------------------------------------------------- */ + +/** Number of blocks that form this topic's content (header + following until next header of any level). */ +static unsigned int help_topiccontentnblocks(const md_topic *topic, const md_file *file) { + unsigned int i = topic->block_index; + unsigned int n = file->blocks.count; + // Advance until we hit any next header (so a # topic doesn't swallow all ## sections) + while (i < n) { + const md_block *b = &file->blocks.data[i]; + if (b->type == MD_BLOCK_HEADER && i > topic->block_index) + break; + i++; + } + return i - topic->block_index; +} + +/** Fill a help_topic view from resolved topic and file. */ +static void help_topicfill(help_topic *out, const md_topic *topic, const md_file *file) { + out->topic = topic; + out->file = file; + out->content_blocks = &file->blocks.data[topic->block_index]; + out->nblocks = help_topiccontentnblocks(topic, file); +} + +/** Validate topic and get source pointer/length; return false if invalid. */ +static bool help_topicsrc(const help_topic *t, const char **src, size_t *src_len) { + if (!t || !t->file || !t->file->source) return false; + *src = t->file->source; + *src_len = t->file->sourcelen; + return true; +} + +bool help_topictotext(const help_topic *t, varray_char *result) { + if (!result) return false; + const char *src; + size_t src_len; + if (!help_topicsrc(t, &src, &src_len)) return false; + for (unsigned int i = 0; i < t->nblocks; i++) { + const md_block *b = &t->content_blocks[i]; + size_t len = md_clamp_span(b->span.start, b->span.length, src_len); + if (len == 0) continue; + + // Per-block: header (title only, no #), paragraph/list/code (span), link/blank skip + switch (b->type) { + case MD_BLOCK_HEADER: { + size_t tlen = md_clamp_span(b->as.header.title.start, b->as.header.title.length, src_len); + const char *p = src + b->as.header.title.start; + while (tlen && (*p == '#' || (unsigned char)*p <= ' ')) { p++; tlen--; } // strip leading # and space + if (tlen > 0) { + varray_charadd(result, (char *) p, (int) tlen); + varray_charwrite(result, '\n'); + } + break; + } + case MD_BLOCK_PARAGRAPH: + case MD_BLOCK_LIST: + case MD_BLOCK_CODE: + varray_charadd(result, (char *) src + b->span.start, (int) len); + if (len > 0 && src[b->span.start + len - 1] != '\n') varray_charadd(result, "\n", 1); + break; + case MD_BLOCK_LINK_DEF: + case MD_BLOCK_THEMATIC_BREAK: + case MD_SHOW_SUBTOPICS: + break; // omit from plain text (thematic breaks render as blank lines) + case MD_BLOCK_BLANK: + varray_charwrite(result, '\n'); + break; + } + } + varray_charwrite(result, '\0'); + return true; +} + +bool help_topicrawmd(const help_topic *t, varray_char *result) { + if (!result) return false; + const char *src; + size_t src_len; + if (!help_topicsrc(t, &src, &src_len)) return false; + for (unsigned int i = 0; i < t->nblocks; i++) { + const md_block *b = &t->content_blocks[i]; + size_t len = md_clamp_span(b->span.start, b->span.length, src_len); + if (len == 0) continue; + varray_charadd(result, (char *) src + b->span.start, (int) len); + if (src[b->span.start + len - 1] != '\n') varray_charadd(result, "\n", 1); + } + return true; +} + +/* ********************************************************************** + * Morpho help files (load and parse) + * ********************************************************************** */ + +/** Parse a markdown file and append blocks/topics to s_topics. */ +bool help_parse(md_file *file, int file_index) { + error err; + error_init(&err); + md_parseout parseout = { + .file = file, + .topics = &s_topics, + .file_index = file_index, + .current_header_level = 1, + .current_topic_index = -1 + }; + lexer l; + help_initializemdlexer(&l, file->source); + parser p; + help_initializemdparser(&p, &l, &err, &parseout); + bool ok = parse(&p); + parse_clear(&p); + lex_clear(&l); + if (!ok && morpho_checkerror(&err)) { + fprintf(stderr, "Help parse error [%s]: %s", err.id ? err.id : "?", err.msg); + bool has_line = (err.line != ERROR_POSNUNIDENTIFIABLE); + bool has_posn = (err.posn != ERROR_POSNUNIDENTIFIABLE); + if (has_line || has_posn) { + fprintf(stderr, " ("); + if (has_line) fprintf(stderr, "line %d", err.line + 1); + if (has_posn) fprintf(stderr, "%sposition %d", has_line ? ", " : "", err.posn + 1); + fprintf(stderr, ")"); + } + if (file->filename) fprintf(stderr, " in %s", file->filename); + fprintf(stderr, "\n"); + } + return ok; +} + +/** Loads a help file into the AST (appends to s_files and s_topics). */ +bool help_load(char *filename) { + FILE *f = fopen(filename, "r"); + if (!f) return false; + varray_char contents; + varray_charinit(&contents); + if (!file_readintovarray(f, &contents)) { + fclose(f); + varray_charclear(&contents); + return false; + } + fclose(f); + size_t len = (contents.count > 0) ? contents.count - 1 : 0; // Keep contents.data; mdfile will own it (freed in md_file_clear). Do not clear contents. + md_file mdfile; + md_file_init(&mdfile); + mdfile.source = contents.data; + mdfile.sourcelen = len; + mdfile.filename = morpho_strdup(filename); + unsigned int n_topics_before = s_topics.count; + bool ok = help_parse(&mdfile, (int) s_files.count); + if (ok) { + varray_md_filewrite(&s_files, mdfile); + } else { + md_file_clear(&mdfile); + while (s_topics.count > n_topics_before) { + help_nameindex_remove((int) s_topics.count - 1, n_topics_before); + s_topics.count--; + } + } + return ok; +} + +/** Finds and loads all help files; sets parent_topic for each topic. Name index is built incrementally during parse. */ +void help_findfiles(void) { + varray_value files; + varray_valueinit(&files); + if (morpho_listresources(MORPHO_RESOURCE_HELP, &files)) { + for (unsigned int i = 0; i < files.count; i++) { + if (MORPHO_ISSTRING(files.data[i])) help_load(MORPHO_GETCSTRING(files.data[i])); + } + for (unsigned int i = 0; i < files.count; i++) morpho_freeobject(files.data[i]); + } + varray_valueclear(&files); + for (unsigned int i = 0; i < s_topics.count; i++) + s_topics.data[i].parent_topic = help_findparent(i); +} + +/* ********************************************************************** + * Hints for failed queries + * ********************************************************************** */ + +/** Append "Topic 'query' not found [. Did you mean 'suggest'?]." to result. suggest is full path or NULL. */ +static void help_hintappend(varray_char *result, const char *query, const char *suggest) { + char buf[MORPHO_HELP_HINTBUFSIZE]; + int n = suggest + ? snprintf(buf, sizeof(buf), "Topic '%s' not found. Did you mean '%s'?", query, suggest) + : snprintf(buf, sizeof(buf), "Topic '%s' not found.", query); + if (n > 0 && (size_t) n < sizeof(buf)) varray_charadd(result, buf, n); +} + +/** Append "Topic 'query' had multiple matches: did you mean 'A' or 'B'?" (or "..., 'A', 'B', or 'C'?"). */ +static void help_hintappend_multi(varray_char *result, const char *query, int indices[], int count) { + char buf[MORPHO_HELP_HINTBUFSIZE]; + char path[MORPHO_MAX_HELPQUERY_LENGTH]; + int n = snprintf(buf, sizeof(buf), "Topic '%s' had multiple matches: did you mean ", query); + // First: "'A'"; middle: ", 'B'"; last: " or 'C'?" + for (int i = 0; i < count && n < (int) sizeof(buf) - 4; i++) { + help_displaypath(indices[i], path, sizeof(path)); + if (i == 0) n += snprintf(buf + n, sizeof(buf) - (size_t) n, "'%s'", path); + else if (i == count - 1) n += snprintf(buf + n, sizeof(buf) - (size_t) n, " or '%s'?", path); + else n += snprintf(buf + n, sizeof(buf) - (size_t) n, ", '%s'", path); + } + if (n > 0 && (size_t) n < sizeof(buf)) varray_charadd(result, buf, n); +} + +static void help_appendothertopics(const char *name, int preferred, varray_char *result) { + int cand[MORPHO_HELP_MAX_MULTIMATCH]; + int n = help_findallbyname(name, cand, MORPHO_HELP_MAX_MULTIMATCH); + int nothers = 0; + + for (int i = 0; i < n; i++) { + if (cand[i] != preferred) nothers++; + } + if (nothers <= 0) return; + + char path[MORPHO_MAX_HELPQUERY_LENGTH]; + varray_charadd(result, "\n\nOther topics:\n", 16); + for (int i = 0; i < n; i++) { + if (cand[i] == preferred) continue; + help_displaypath(cand[i], path, sizeof(path)); + varray_charadd(result, "- ", 2); + varray_charadd(result, path, strlen(path)); + varray_charwrite(result, '\n'); + } +} + +/** Build a hint for a failed query and append to result (caller may clear result first). */ +void help_queryhint(const char *query, varray_char *result) { + if (!result) return; + help_queryparts parsed; + + if (help_parsequery(query, &parsed) == 0) { + varray_charadd(result, MORPHO_HELP_NOTFOUND, strlen(MORPHO_HELP_NOTFOUND)); + varray_charwrite(result, '\0'); + return; + } + // Single segment: multi-match hint, or "not found" + closest, or NOTFOUND + if (parsed.nsegs == 1) { + int multi[MORPHO_HELP_MAX_MULTIMATCH]; + int n = help_findallbyname(parsed.segs[0], multi, MORPHO_HELP_MAX_MULTIMATCH); + if (n >= 2) { + help_hintappend_multi(result, query, multi, n); + varray_charwrite(result, '\0'); + return; + } + if (n == 0) { + help_hintappend(result, query, help_findclosesttopic(parsed.segs[0], -1)); + varray_charwrite(result, '\0'); + return; + } + varray_charadd(result, MORPHO_HELP_NOTFOUND, strlen(MORPHO_HELP_NOTFOUND)); + varray_charwrite(result, '\0'); + return; + } + // Multi-segment: resolve first, then walk subtopics; on first failure suggest path.closest + int idx = help_findtopic(parsed.segs[0]); + if (idx < 0) { + help_hintappend(result, query, help_findclosesttopic(parsed.segs[0], -1)); + varray_charwrite(result, '\0'); + return; + } + char path[MORPHO_MAX_HELPQUERY_LENGTH]; + int path_len = snprintf(path, sizeof(path), "%s", parsed.segs[0]); + if (path_len < 0 || path_len >= (int) sizeof(path)) path_len = (int) sizeof(path) - 1; + + for (int i = 1; i < parsed.nsegs; i++) { + int next = help_findchild(idx, parsed.segs[i]); + if (next < 0) { + const char *closest = help_findclosesttopic(parsed.segs[i], idx); + char suggest[MORPHO_MAX_HELPQUERY_LENGTH] = {0}; + if (closest) { + int needed = path_len + 1 + (int) strlen(closest); + if (needed < (int) sizeof(suggest)) + snprintf(suggest, sizeof(suggest), "%s.%s", path, closest); + } + help_hintappend(result, query, suggest[0] ? suggest : NULL); + varray_charwrite(result, '\0'); + return; + } + idx = next; + // Append "." + segs[i] to path for next level + if (path_len >= (int) sizeof(path) - 1) continue; // No room + int n = snprintf(path + path_len, (size_t)(sizeof(path) - path_len), ".%s", parsed.segs[i]); + if (n > 0) path_len += (n < (int) sizeof(path) - path_len) ? n : (int) sizeof(path) - 1 - path_len; + } + varray_charadd(result, MORPHO_HELP_NOTFOUND, strlen(MORPHO_HELP_NOTFOUND)); + varray_charwrite(result, '\0'); +} + +/* ********************************************************************** + * Help API + * ********************************************************************** */ + +static bool s_help_files_loaded = false; + +static void help_ensureloaded(void) { + if (!s_help_files_loaded) { + help_findfiles(); + s_help_files_loaded = true; + } +} + +/** Interface to the morpho help system. Query may be "Topic" or "Topic subtopic" / "Topic.subtopic". */ +bool morpho_helpastopic(const char *query, help_topic *out) { + help_ensureloaded(); + help_queryparts parsed; + if (help_parsequery(query, &parsed) <= 0) return false; + + int idx = help_resolvetopic(&parsed); + if (idx < 0) return false; + + const md_topic *topic = &s_topics.data[idx]; + if (topic->file_index < 0 || (unsigned int) topic->file_index >= s_files.count) return false; + const md_file *file = &s_files.data[topic->file_index]; + if (topic->block_index >= file->blocks.count) return false; + help_topicfill(out, topic, file); + return true; +} + +bool morpho_helpastext(const char *query, varray_char *result) { + help_topic t; + if (morpho_helpastopic(query, &t)) { + bool success = help_topictotext(&t, result); + help_queryparts parsed; + + if (success && help_parsequery(query, &parsed) == 1) { + help_appendothertopics(parsed.segs[0], help_findtopic(parsed.segs[0]), result); + } + return success; + } + help_queryhint(query, result); + return false; +} + +bool morpho_helpasmd(const char *query, varray_char *result) { + help_topic t; + if (morpho_helpastopic(query, &t)) return help_topicrawmd(&t, result); + help_queryhint(query, result); + return false; +} + +/** True if topic at index i is top-level (level 1 or promoted level 2). */ +static bool help_istopleveltopic(unsigned int i) { + if (i >= s_topics.count) return false; + const md_topic *t = &s_topics.data[i]; + bool include = (t->level == 1); + if (!include && t->file_index >= 0 && (unsigned int) t->file_index < s_files.count) + include = s_files.data[t->file_index].promote_subtopics; + return include; +} + +/** Fill a varray_value with top-level topic names. */ +void morpho_helptopics(varray_value *out) { + if (!out) return; + help_ensureloaded(); + if (!s_names.contents) return; + for (unsigned int i = 0; i < s_names.capacity; i++) { + const dictionaryentry *e = &s_names.contents[i]; + if (MORPHO_ISNIL(e->key) || !MORPHO_ISSTRING(e->key)) continue; + int ti = help_firstindex(e->val); + if (ti < 0 || !help_istopleveltopic((unsigned int) ti)) continue; + varray_valuewrite(out, e->key); + } +} + +/** Fills a varray_value with subtopic names for the given topic. */ +void morpho_helpsubtopics(const help_topic *topic, varray_value *out) { + if (!topic || !topic->topic || !out) return; + int topic_index = (int)(topic->topic - s_topics.data); + if (topic_index < 0 || (unsigned int) topic_index >= s_topics.count) return; + for (unsigned int i = 0; i < s_topics.count; i++) { + const md_topic *t = &s_topics.data[i]; + if (t->parent_topic != topic_index || !MORPHO_ISSTRING(t->name)) continue; + varray_valuewrite(out, t->name); + } +} + +/* ********************************************************************** + * Initialization/finalization + * ********************************************************************** */ + +/** @brief Initialize help system */ +void help_initialize(void) { + // Markdown parser errors + morpho_defineerror(MD_UNCLOSEDITALIC, ERROR_PARSE, MD_UNCLOSEDITALIC_MSG); + morpho_defineerror(MD_UNCLOSEDINLINECODE, ERROR_PARSE, MD_UNCLOSEDINLINECODE_MSG); + morpho_defineerror(MD_EXPECTLINEEND, ERROR_PARSE, MD_EXPECTLINEEND_MSG); + morpho_defineerror(MD_EXPECTHEADERTEXT, ERROR_PARSE, MD_EXPECTHEADERTEXT_MSG); + morpho_defineerror(MD_LINKEXPECTTEXT, ERROR_PARSE, MD_LINKEXPECTTEXT_MSG); + morpho_defineerror(MD_LINKEXPECTBRACKET, ERROR_PARSE, MD_LINKEXPECTBRACKET_MSG); + morpho_defineerror(MD_LINKEXPECTCOLON, ERROR_PARSE, MD_LINKEXPECTCOLON_MSG); + morpho_defineerror(MD_UNEXPECTEDTOKEN, ERROR_PARSE, MD_UNEXPECTEDTOKEN_MSG); + + varray_md_fileinit(&s_files); + varray_md_topicinit(&s_topics); + dictionary_init(&s_names); + morpho_addfinalizefn(help_finalize); +} + +/** @brief Finalization: free all files, topics, and name index. */ +void help_finalize(void) { + for (unsigned int i = 0; i < s_files.count; i++) + md_file_clear(&s_files.data[i]); + varray_md_fileclear(&s_files); + dictionary_freecontents(&s_names, true, true); + dictionary_clear(&s_names); + varray_md_topicclear(&s_topics); +} + +#endif diff --git a/src/support/help.h b/src/support/help.h new file mode 100644 index 000000000..e5781c0ab --- /dev/null +++ b/src/support/help.h @@ -0,0 +1,177 @@ +/** @file help.h + * @author T J Atherton and others (see below) + * + * @brief Morpho help +*/ + +#ifndef help_h +#define help_h + +#ifdef MORPHO_INCLUDE_HELP + +#include +#include "varray.h" +#include "value.h" + +/** Maximum length of a help query string (used for lookup buffer). */ +#define MORPHO_MAX_HELPQUERY_LENGTH 512 + +/** Maximum length of a single string for edit-distance (suggestion). */ +#define MORPHO_HELP_EDITMAXLEN 128 + +/** Maximum number of query segments (e.g. "System.clock" -> 2). */ +#define MORPHO_HELP_QUERY_MAXSEGMENTS 8 +/** Maximum number of topic indices returned for a single name (multi-match). */ +#define MORPHO_HELP_MAX_MULTIMATCH 8 + +/** Buffer size for "not found" hint message. */ +#define MORPHO_HELP_HINTBUFSIZE 256 + +/* ------------------------------------------------------- + * Markdown AST: source-backed spans, hierarchical blocks + * ------------------------------------------------------- */ + +/** Span into a stored source buffer (offset + length). */ +typedef struct { + size_t start; + size_t length; +} md_span; + +/** Block type. */ +typedef enum { + MD_BLOCK_HEADER, + MD_BLOCK_PARAGRAPH, + MD_BLOCK_CODE, + MD_BLOCK_LIST, + MD_BLOCK_LINK_DEF, + MD_BLOCK_THEMATIC_BREAK, + MD_BLOCK_BLANK, + MD_SHOW_SUBTOPICS +} md_blocktype; + +/** A single block: maps to a span in source; type-specific data; optional hierarchy. */ +typedef struct { + md_blocktype type; + md_span span; + union { + struct { int level; md_span title; } header; + struct { md_span label; md_span target; } link_def; + /* paragraph, code, list: span covers content */ + } as; + int parent; /* block index of parent, or -1 if top-level */ + varray_int children; /* indices of child blocks within same file */ +} md_block; + +DECLARE_VARRAY(md_block, md_block); + +/** One source file: owned source text + varray of blocks (with spans into source). */ +typedef struct { + char *source; + size_t sourcelen; + char *filename; /* Owned filename/path for error reporting */ + bool promote_subtopics; /* [toplevel]: # directive: include ## from this file in top-level topic list */ + varray_md_block blocks; +} md_file; + +DECLARE_VARRAY(md_file, md_file); + +/** Topic entry: header in the master list (load order). Hierarchy by parent_topic; lookup by name/alias via single dictionary (value = index or List of indices). */ +typedef struct { + value name; /* Morpho string (lowercase); not owned */ + int file_index; + unsigned int block_index; + int level; /* header level 1–3 */ + int parent_topic; /* topic index of parent, or -1 */ +} md_topic; + +DECLARE_VARRAY(md_topic, md_topic); + +/** Initialize / clear a block (clears children). */ +void md_block_clear(md_block *b); + +/** Initialize / clear a file (frees source, clears blocks). */ +void md_file_init(md_file *f); +void md_file_clear(md_file *f); + +/** Find one topic index by name or alias, preferring the shallowest unique match. Returns -1 if not found. */ +int help_findtopic(const char *name); + +/** Find all topic indices with given name. Fills indices[] up to max, returns count. */ +int help_findallbyname(const char *name, int indices[], int max); + +/* ------------------------------------------------------- + * Help topic view (for flexible rendering) + * ------------------------------------------------------- */ + +/** A resolved help topic: pointer to the topic entry, its file, and the slice of blocks that form its content (header + following blocks until the next same-level or higher header). Callers can use this to render raw MD, plain text, or terminal-styled output. */ +typedef struct { + const md_topic *topic; + const md_file *file; + const md_block *content_blocks; /* first block of content (header) */ + unsigned int nblocks; +} help_topic; + +/** Render a help topic as plain text into result (no markdown formatting). Returns true on success. */ +bool help_topictotext(const help_topic *t, varray_char *result); + +/** Append a help topic's raw markdown from source into result. Returns true on success. */ +bool help_topicrawmd(const help_topic *t, varray_char *result); + +/* ------------------------------------------------------- + * Markdown parser error codes + * ------------------------------------------------------- */ + +#define MD_UNCLOSEDITALIC "MDUnclItal" +#define MD_UNCLOSEDITALIC_MSG "Unclosed italic (missing closing * or _)." + +#define MD_UNCLOSEDINLINECODE "MDUnclCode" +#define MD_UNCLOSEDINLINECODE_MSG "Unclosed inline code (missing closing `)." + +#define MD_EXPECTLINEEND "MDExpLnEnd" +#define MD_EXPECTLINEEND_MSG "Expected end of line." + +#define MD_EXPECTHEADERTEXT "MDExpHdrTxt" +#define MD_EXPECTHEADERTEXT_MSG "Expected header text after #." + +#define MD_LINKEXPECTTEXT "MDLnkExpTxt" +#define MD_LINKEXPECTTEXT_MSG "Link definition expects label text after [." + +#define MD_LINKEXPECTBRACKET "MDLnkExpBr" +#define MD_LINKEXPECTBRACKET_MSG "Link definition expects ] after label." + +#define MD_LINKEXPECTCOLON "MDLnkExpCol" +#define MD_LINKEXPECTCOLON_MSG "Link definition expects : after ]." + +#define MD_UNEXPECTEDTOKEN "MDUnexpTok" +#define MD_UNEXPECTEDTOKEN_MSG "Unexpected markdown token." + +#define MORPHO_HELP_NOTFOUND "Topic not found." + +/* ------------------------------------------------------- + * Help API + * ------------------------------------------------------- */ + +/** Resolve a query to a help topic. Fills *out and returns true if found; otherwise returns false and *out is unchanged. */ +bool morpho_helpastopic(const char *query, help_topic *out); + +/** Look up help for query and write plain-text result. Returns true if topic found. (Convenience wrapper for morpho_helpastopic + help_topictotext.) */ +bool morpho_helpastext(const char *query, varray_char *result); + +/** Look up help for query and write raw markdown into result. Returns true if topic found. (Convenience wrapper for morpho_helpastopic + help_topicrawmd.) */ +bool morpho_helpasmd(const char *query, varray_char *result); + +/** Fill a varray_value with top-level topic names (Morpho string values). Loads help on first use. Caller must initialize/clear the varray. */ +void morpho_helptopics(varray_value *out); + +/** Fill a varray_value with subtopic names (Morpho string values) for the given topic. Each name is added once (by identity). Loads help on first use. Caller must initialize/clear the varray. */ +void morpho_helpsubtopics(const help_topic *topic, varray_value *out); + +/** Build a hint for a failed query */ +void help_queryhint(const char *query, varray_char *result); + +void help_initialize(void); +void help_finalize(void); + +#endif + +#endif /* help_h */ diff --git a/src/support/lex.c b/src/support/lex.c index 53a2ca1f8..8bd155e05 100644 --- a/src/support/lex.c +++ b/src/support/lex.c @@ -157,11 +157,12 @@ bool lex_matchtoken(lexer *l, tokendefn **defn) { return def; } -/** @brief Attempts to identify a token from the current point, advances if it finds one. +/** @brief Attempts to identify a token from the current point * @param[in] l The lexer in use + * @param[in] advance Should we advance if we find the token? * @param[out] defn Type of token, if found * @returns true if the token matched, false if not */ -bool lex_identifytoken(lexer *l, tokendefn **defn) { +bool lex_identifytoken(lexer *l, bool advance, tokendefn **defn) { char c = lex_peek(l); // Match first character @@ -177,7 +178,7 @@ bool lex_identifytoken(lexer *l, tokendefn **defn) { for (; def->string[0]==c && def>=l->defns; def--) { size_t len=strlen(def->string); if (strncmp(def->string, l->current, len)==0) { - lex_advanceby(l, len); + if (advance) lex_advanceby(l, len); if (defn) *defn = def; return true; } @@ -673,7 +674,7 @@ bool lex(lexer *l, token *tok, error *err) { } tokendefn *defn=NULL; - if (lex_identifytoken(l, &defn)) { + if (lex_identifytoken(l, true, &defn)) { lex_recordtoken(l, defn->type, tok); } else { morpho_writeerrorwithid(err, LEXER_UNRECOGNIZEDTOKEN, NULL, l->line, l->posn); diff --git a/src/support/lex.h b/src/support/lex.h index 597f22bc0..9b74ea12d 100644 --- a/src/support/lex.h +++ b/src/support/lex.h @@ -168,8 +168,10 @@ enum { bool lex_findtoken(lexer *l, tokendefn **defn); bool lex_matchtoken(lexer *l, tokendefn **defn); +bool lex_identifytoken(lexer *l, bool advance, tokendefn **defn); void lex_recordtoken(lexer *l, tokentype type, token *tok); char lex_advance(lexer *l); +char lex_advanceby(lexer *l, size_t n); bool lex_back(lexer *l); bool lex_isatend(lexer *l); bool lex_isalpha(char c); diff --git a/src/support/parse.c b/src/support/parse.c index 384be9cda..81a812c91 100644 --- a/src/support/parse.c +++ b/src/support/parse.c @@ -18,9 +18,6 @@ /** Varrays of parse rules */ DEFINE_VARRAY(parserule, parserule) -/** Macro to check return of a bool function */ -#define PARSE_CHECK(f) if (!(f)) return false; - /* ********************************************************************** * Parser utility functions * ********************************************************************** */ @@ -479,7 +476,7 @@ bool parse_arglist(parser *p, tokentype rightdelimiter, unsigned int *nargs, voi return true; } -/** Parses a variable name, or raises and error if a symbol isn't found */ +/** Parses a variable name, or raises an error if a symbol isn't found */ bool parse_variable(parser *p, errorid id, void *out) { PARSE_CHECK(parse_checkrequiredtoken(p, TOKEN_SYMBOL, id)); return parse_symbol(p, out); @@ -1055,9 +1052,9 @@ bool parse_typedvardeclaration(parser *p, void *out) { PARSE_CHECK(parse_addnode(p, NODE_DOT, MORPHO_NIL, &start, namespace, type, &type)); PARSE_CHECK(parse_addnode(p, NODE_TYPE, MORPHO_NIL, &start, type, var, &new)); - } else { // Perhaps it was really an expression statement + } else { // Return failure parse_restorestate(&op, &ol, p); - PARSE_CHECK(parse_statement(p, &new)); + return false; } *((syntaxtreeindx *) out) = new; @@ -1265,7 +1262,7 @@ bool parse_blockstatement(parser *p, void *out) { parse_error(p, false, PARSE_INCOMPLETEEXPRESSION); return false; } else { - PARSE_CHECK(parse_checkrequiredtoken(p, TOKEN_RIGHTCURLYBRACKET, PARSE_MISSINGSEMICOLONEXP)); + PARSE_CHECK(parse_checkrequiredtoken(p, TOKEN_RIGHTCURLYBRACKET, PARSE_BLOCKTERMINATOREXP)); } return parse_addnode(p, NODE_SCOPE, MORPHO_NIL, &start, SYNTAXTREE_UNCONNECTED, body, out); @@ -1324,6 +1321,8 @@ bool parse_forstatement(parser *p, void *out) { } else if (parse_checktokenadvance(p, TOKEN_VAR)) { PARSE_CHECK(parse_vardeclaration(p, &init)); + } else if (parse_checktoken(p, TOKEN_SYMBOL) && + parse_typedvardeclaration(p, &init)) { } else { PARSE_CHECK(parse_expression(p, &init)); while (parse_checktokenadvance(p, TOKEN_COMMA)) { @@ -1535,6 +1534,7 @@ bool parse_declaration(parser *p, void *out) { success=parse_importdeclaration(p, out); } else if (parse_checktoken(p, TOKEN_SYMBOL)) { // Typed var declaration ? success=parse_typedvardeclaration(p, out); + if (!success) success=parse_statement(p, out); // Try statement instead } else { success=parse_statement(p, out); } @@ -1859,9 +1859,7 @@ void parse_initialize(void) { morpho_defineerror(PARSE_INCOMPLETEEXPRESSION, ERROR_PARSE, PARSE_INCOMPLETEEXPRESSION_MSG); morpho_defineerror(PARSE_MISSINGPARENTHESIS, ERROR_PARSE, PARSE_MISSINGPARENTHESIS_MSG); morpho_defineerror(PARSE_EXPECTEXPRESSION, ERROR_PARSE, PARSE_EXPECTEXPRESSION_MSG); - morpho_defineerror(PARSE_MISSINGSEMICOLON, ERROR_PARSE, PARSE_MISSINGSEMICOLON_MSG); morpho_defineerror(PARSE_MISSINGSEMICOLONEXP, ERROR_PARSE, PARSE_MISSINGSEMICOLONEXP_MSG); - morpho_defineerror(PARSE_MISSINGSEMICOLONVAR, ERROR_PARSE, PARSE_MISSINGSEMICOLONVAR_MSG); morpho_defineerror(PARSE_VAREXPECTED, ERROR_PARSE, PARSE_VAREXPECTED_MSG); morpho_defineerror(PARSE_SYMBLEXPECTED, ERROR_PARSE, PARSE_SYMBLEXPECTED_MSG); morpho_defineerror(PARSE_BLOCKTERMINATOREXP, ERROR_PARSE, PARSE_BLOCKTERMINATOREXP_MSG); @@ -1872,7 +1870,6 @@ void parse_initialize(void) { morpho_defineerror(PARSE_IFRGHTPARENMISSING, ERROR_PARSE, PARSE_IFRGHTPARENMISSING_MSG); morpho_defineerror(PARSE_WHILELFTPARENMISSING, ERROR_PARSE, PARSE_WHILELFTPARENMISSING_MSG); morpho_defineerror(PARSE_FORLFTPARENMISSING, ERROR_PARSE, PARSE_FORLFTPARENMISSING_MSG); - morpho_defineerror(PARSE_FORSEMICOLONMISSING, ERROR_PARSE, PARSE_FORSEMICOLONMISSING_MSG); morpho_defineerror(PARSE_FORRGHTPARENMISSING, ERROR_PARSE, PARSE_FORRGHTPARENMISSING_MSG); morpho_defineerror(PARSE_FNNAMEMISSING, ERROR_PARSE, PARSE_FNNAMEMISSING_MSG); morpho_defineerror(PARSE_FNLEFTPARENMISSING, ERROR_PARSE, PARSE_FNLEFTPARENMISSING_MSG); diff --git a/src/support/parse.h b/src/support/parse.h index 9c1ec984d..70b9ade4d 100644 --- a/src/support/parse.h +++ b/src/support/parse.h @@ -70,6 +70,9 @@ typedef struct { /** Varrays of parse rules */ DECLARE_VARRAY(parserule, parserule) +/** Macro to check return of a bool function */ +#define PARSE_CHECK(f) if (!(f)) return false; + /* ------------------------------------------------------- * Define a Parser * ------------------------------------------------------- */ @@ -113,15 +116,9 @@ struct sparser { #define PARSE_EXPECTEXPRESSION "ExpExpr" #define PARSE_EXPECTEXPRESSION_MSG "Expected expression." -#define PARSE_MISSINGSEMICOLON "MssngSemiVal" -#define PARSE_MISSINGSEMICOLON_MSG "Expect ; after value." - #define PARSE_MISSINGSEMICOLONEXP "MssngExpTerm" #define PARSE_MISSINGSEMICOLONEXP_MSG "Expect expression terminator (; or newline) after expression." -#define PARSE_MISSINGSEMICOLONVAR "MssngSemiVar" -#define PARSE_MISSINGSEMICOLONVAR_MSG "Expect ; after variable declaration." - #define PARSE_VAREXPECTED "VarExpct" #define PARSE_VAREXPECTED_MSG "Variable name expected after var." @@ -152,9 +149,6 @@ struct sparser { #define PARSE_FORLFTPARENMISSING "ForMssngLftPrn" #define PARSE_FORLFTPARENMISSING_MSG "Expected '(' after for." -#define PARSE_FORSEMICOLONMISSING "ForMssngSemi" -#define PARSE_FORSEMICOLONMISSING_MSG "Expected ';'." - #define PARSE_FORRGHTPARENMISSING "ForMssngRgtPrn" #define PARSE_FORRGHTPARENMISSING_MSG "Expected ')' after for clauses." diff --git a/src/support/platform.c b/src/support/platform.c index b3d9d7e1a..63243af39 100644 --- a/src/support/platform.c +++ b/src/support/platform.c @@ -10,6 +10,26 @@ * - APIs for using threads * - Functions that involve time */ +#define _GNU_SOURCE + +#ifdef _WIN32 + #include + #include +#else + #ifndef __APPLE__ // _POSIX_C_SOURCE Causes problems with qsort_r on apple + #define _POSIX_C_SOURCE 199309L + #endif + #include + #include + #include + #include + #include + #include + #include + #include + #include +#endif + #include #include #include @@ -18,21 +38,6 @@ #include "platform.h" #include "error.h" -#ifdef _WIN32 -#include -#include -#else -#define _POSIX_C_SOURCE 199309L -#include -#include -#include -#include -#include -#include -#include -#include -#endif - /* ********************************************************************** * Platform name * ********************************************************************** */ @@ -50,6 +55,43 @@ const char *platform_name(void) { return NULL; // Unrecognized platform } +/* ********************************************************************** + * Re-entrant qsort + * ********************************************************************** */ + +typedef struct _sadapt { + void *context; + platform_qsort_r_comparefn cmp; +} _adaptinfo; + +/** Adapter function to patch macOS, BSD and windows variants of qsort_r */ +static int _comparefn_adapter(void *in, const void *a, const void *b) { + _adaptinfo *info = (_adaptinfo *) in; + return info->cmp(a,b,info->context); +} + +/** Fallback function for use with regular qsort @warning not thread-safe */ +static _adaptinfo _globalinfo; +static int _comparefn_fallback(const void *a, const void *b) { + return _globalinfo.cmp(a,b,_globalinfo.context); +} + +/** Platform independent re-entrant qsort function */ +void platform_qsort_r(void *base, size_t nel, size_t width, void *context, platform_qsort_r_comparefn cmp) { +#if defined(__GLIBC__) || defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) + qsort_r(base, nel, width, cmp, context); +#elif defined(__APPLE__) + _adaptinfo info = { .context = context, .cmp = cmp }; + qsort_r(base, nel, width, &info, _comparefn_adapter); +#elif defined(_WIN32) + _adaptinfo info = { .context = context, .cmp = cmp }; + qsort_s(base, nel, width, _comparefn_adapter, &info); +#else + _globalinfo.cmp = cmp; _globalinfo.context = context; + qsort(base, nel, width, _comparefn_fallback); +#endif +} + /* ********************************************************************** * Random numbers * ********************************************************************** */ @@ -111,7 +153,16 @@ bool MCEq(MorphoComplex a, MorphoComplex b) { * File system functions * ********************************************************************** */ -/* Tells if an object at path corresponds to a directory */ +/** Returns the maximum size of a file path */ +size_t platform_maxpathsize(void) { +#ifdef _WIN32 + return (size_t) MAX_PATH*4; +#else + return pathconf("/", _PC_PATH_MAX); +#endif +} + +/** Tests if an object at path corresponds to a directory */ bool platform_isdirectory(const char *path) { #ifdef _WIN32 DWORD attributes = GetFileAttributes(path); @@ -125,15 +176,72 @@ bool platform_isdirectory(const char *path) { #endif } -/** Returns the maximum size of a file path */ -size_t platform_maxpathsize(void) { -#ifdef _WIN32 - return (size_t) MAX_PATH; -#else - return pathconf("/", _PC_PATH_MAX); +/** Normalizes a filepath for the current platform */ +bool platform_normalizepath(const char *path, size_t n, char *out) { + for (size_t i = 0; i < n; i++) { +#ifdef _WIN32 + if (path[i] == '/') out[i] = '\\'; +#else + if (path[i] == '\\') out[i] = '/'; +#endif + else out[i]=path[i]; + + if (path[i]=='\0') return true; + } + return false; +} + +/** Helper function to make a single directory */ +static bool _makedir(const char *path) { +#ifdef _WIN32 + return CreateDirectoryA(path, NULL) || + GetLastError() == ERROR_ALREADY_EXISTS; +#else + return mkdir(path, S_IRWXU | S_IRWXG | S_IRWXO) == 0 || + errno == EEXIST; #endif } +/** Creates a directory, optionally recursively creating folders */ +bool platform_makedirectory(const char *path, bool recurse) { + size_t n=platform_maxpathsize(); + char buffer[n]; + if (!platform_normalizepath(path, n, buffer)) return false; + + if (!recurse) return _makedir(buffer); + + size_t i=0, len=strlen(buffer); + if (len==0) return false; + + // Strip trailing separators + while (len > 1 && (buffer[len-1] == '\\' || buffer[len-1] == '/')) buffer[--len] = '\0'; + +#ifdef _WIN32 + if (len >= 3 && buffer[1] == ':' && buffer[2] == '\\') i = 3; // Skip drive letter + else if (len >= 5 && buffer[0] == '\\' && buffer[1] == '\\') { // Skip UNC prefix: \\server\share\... + int nSlashes = 0; + for (i = 2; i < len; i++) { + if (buffer[i] == '\\' && ++nSlashes == 2) { + i++; + break; + } + } + } +#endif + + // Walk the path and create intermediate directories + for (; i < len; i++) { + if (buffer[i] == '\\' || buffer[i] == '/') { + char swp = buffer[i]; + buffer[i] = '\0'; + if (!_makedir(buffer)) return false; + buffer[i] = swp; + } + } + + return _makedir(buffer); +} + /** Sets the current working directory to path */ bool platform_setcurrentdirectory(const char *path) { #ifdef _WIN32 @@ -266,7 +374,7 @@ void *platform_dlsym(MorphoDLHandle handle, const char *symbol) { DEFINE_VARRAY(MorphoThread, MorphoThread); -/** Creates a thread */ +/** Creates a thread; returns true on success */ bool MorphoThread_create(MorphoThread *thread, MorphoThreadFn threadfn, void *ref) { #ifdef _WIN32 DWORD threadId; diff --git a/src/support/platform.h b/src/support/platform.h index b1fc56682..bf56ab193 100644 --- a/src/support/platform.h +++ b/src/support/platform.h @@ -30,6 +30,15 @@ const char *platform_name(void); +/* ------------------------------------------------------- + * Re-entrant qsort + * ------------------------------------------------------- */ + +typedef int (*platform_qsort_r_comparefn)(const void *, const void *, void *); + +/** Sort elements with additional context passed to the comparator function */ +void platform_qsort_r(void *base, size_t nel, size_t width, void *context, platform_qsort_r_comparefn cmp); + /* ------------------------------------------------------- * Random numbers * ------------------------------------------------------- */ @@ -75,10 +84,12 @@ bool MCEq(MorphoComplex a, MorphoComplex b); * ------------------------------------------------------- */ size_t platform_maxpathsize(void); +bool platform_isdirectory(const char *path); +bool platform_normalizepath(const char *path, size_t n, char *out); +bool platform_makedirectory(const char *path, bool recurse); bool platform_setcurrentdirectory(const char *path); bool platform_getcurrentdirectory(char *buffer, size_t size); bool platform_gethomedirectory(char *buffer, size_t size); -bool platform_isdirectory(const char *path); typedef struct { #ifdef _WIN32 diff --git a/test/block/empty_block_reachability.morpho b/test/block/empty_block_reachability.morpho new file mode 100644 index 000000000..5e8019172 --- /dev/null +++ b/test/block/empty_block_reachability.morpho @@ -0,0 +1,21 @@ +// Reachability of empty block + +var refine_adaptively = false +var refine_iters = 1 +var visualize_refinement = false + +print "Refine adaptively: ${refine_adaptively}" + +if (refine_adaptively){ + print "Refine adaptively: ${refine_adaptively}" + + for (i in 1..refine_iters) { + System.exit() + + if (visualize_refinement){ + + } + } +} + +// expect: Refine adaptively: false diff --git a/test/block/empty_block_reachability_include.morpho b/test/block/empty_block_reachability_include.morpho new file mode 100644 index 000000000..e7b7281d7 --- /dev/null +++ b/test/block/empty_block_reachability_include.morpho @@ -0,0 +1,23 @@ +// Reachability of empty block after include + +import meshtools + +var refine_adaptively = false // Flag to turn mesh-refinement on/off +var refine_iters = 1 // Number of iterations of refimenent +var visualize_refinement = false // Flag to turn plotting the refinement regions and refined meshes on/off + +print "Refine adaptively: ${refine_adaptively}" + +if (refine_adaptively){ + for (i in 1..refine_iters) { + + print "Refining" + System.exit() + + if (visualize_refinement){ + + } + } +} + +// expect: Refine adaptively: false diff --git a/test/builtin/apply.morpho b/test/builtin/apply.morpho index 605e7f467..54ead034c 100644 --- a/test/builtin/apply.morpho +++ b/test/builtin/apply.morpho @@ -14,4 +14,4 @@ apply(f, 1,2,3) // expect: 6 apply([1,2,3], f) -// expect error 'ApplyNtCllble' \ No newline at end of file +// expect error 'MltplDsptchFld' diff --git a/test/builtin/mod.morpho b/test/builtin/mod.morpho index bc086f65e..cc7b031b7 100644 --- a/test/builtin/mod.morpho +++ b/test/builtin/mod.morpho @@ -12,5 +12,16 @@ print mod(4, 2.5) print mod(3.4, 1.1) // expect: 0.1 -print mod(1,2,3) -// expect Error 'InvldArgs' +try { + print mod(1,2,3) +} catch { + "InvldArgs" : print "ok" +} +// expect: ok + +try { + print mod(1.5,2,3) +} catch { + "InvldArgs" : print "ok" +} +// expect: ok diff --git a/test/builtin/random.morpho b/test/builtin/random.morpho new file mode 100644 index 000000000..45adb3c02 --- /dev/null +++ b/test/builtin/random.morpho @@ -0,0 +1,13 @@ +// Check that random number generators work + +var a = random() +print a.clss() // expect: @Float + +var a = randomint() +print a.clss() // expect: @Int + +var a = randomint(10) +print a.clss() // expect: @Int + +var a = randomnormal() +print a.clss() // expect: @Float \ No newline at end of file diff --git a/test/builtin/veneer.morpho b/test/builtin/veneer.morpho new file mode 100644 index 000000000..5d7b94e40 --- /dev/null +++ b/test/builtin/veneer.morpho @@ -0,0 +1,6 @@ +// Veneer class for builtin functions + +print apply.clss() // expect: @Metafunction + +print apply.tostring() +// expect: diff --git a/test/class/class_constructor_from_global.morpho b/test/class/class_constructor_from_global.morpho new file mode 100644 index 000000000..d8bd4a624 --- /dev/null +++ b/test/class/class_constructor_from_global.morpho @@ -0,0 +1,31 @@ +// Class constructor from a global variable + +class MiniSphere { + init(vertices, indx) { + var n = indx.count()-1 + var b = Matrix(n) + self.n = n + self.b = b + } +} + +class Repro { + init(pts) { + self.pts = pts + } + + run() { + var extel = List(0, 1) + extel.append(2) + return MiniSphere(self.pts, extel) + } +} + +var pts = [ + Matrix([0, 0]), + Matrix([1, 0]), + Matrix([0, 1]), + Matrix([2, 2]) +] + +print Repro(pts).run() // expect: diff --git a/test/complex/types/type_complex_add_violation.morpho b/test/complex/types/type_complex_add_violation.morpho new file mode 100644 index 000000000..3bf3e091d --- /dev/null +++ b/test/complex/types/type_complex_add_violation.morpho @@ -0,0 +1,6 @@ +// Check type detection for add + +Complex a = 1im +var b = 1 + +Float c = a + b // expect error 'TypeChk' diff --git a/test/complex/types/type_complex_power.morpho b/test/complex/types/type_complex_power.morpho new file mode 100644 index 000000000..e32a8158e --- /dev/null +++ b/test/complex/types/type_complex_power.morpho @@ -0,0 +1,14 @@ +// Check type inference + +Float R = 2.0 +Complex Z = 1 + 2im + +{ + Float a = R^2 + + Complex b = Z^2 + + Complex c = R^Z + + Complex d = Z^Z +} diff --git a/test/complex/types/type_complex_power_violation.morpho b/test/complex/types/type_complex_power_violation.morpho new file mode 100644 index 000000000..cbcffe427 --- /dev/null +++ b/test/complex/types/type_complex_power_violation.morpho @@ -0,0 +1,7 @@ +// Check type inference + +Complex Z = 1 + 2im + +{ + Float a = Z^2 // expect error 'TypeChk' +} diff --git a/test/complex/types/type_complex_types.morpho b/test/complex/types/type_complex_types.morpho new file mode 100644 index 000000000..f588e6685 --- /dev/null +++ b/test/complex/types/type_complex_types.morpho @@ -0,0 +1,18 @@ +// Check type detection for add + +{ + Complex a = 1+1im + + Float b = a.real() + Float c = a.imag() + Float d = a.abs() + Float e = a.angle() + + Complex f = a + a + Complex g = a - a + Complex h = a * a + Complex p = a / a + Complex q = a ^ a +} + +print "ok" // expect: ok diff --git a/test/field/discretizations/cg1_area_in_2d_grad.morpho b/test/field/discretizations/cg1/cg1_area_in_2d_grad.morpho similarity index 100% rename from test/field/discretizations/cg1_area_in_2d_grad.morpho rename to test/field/discretizations/cg1/cg1_area_in_2d_grad.morpho diff --git a/test/field/discretizations/cg1_area_in_2d_grad_old.morpho b/test/field/discretizations/cg1/cg1_area_in_2d_grad_old.morpho similarity index 100% rename from test/field/discretizations/cg1_area_in_2d_grad_old.morpho rename to test/field/discretizations/cg1/cg1_area_in_2d_grad_old.morpho diff --git a/test/field/discretizations/cg1/cg1_area_in_2d_hess.morpho b/test/field/discretizations/cg1/cg1_area_in_2d_hess.morpho new file mode 100644 index 000000000..83a913b30 --- /dev/null +++ b/test/field/discretizations/cg1/cg1_area_in_2d_hess.morpho @@ -0,0 +1,23 @@ +// Hessian of CG1 field should fail because CG1 has no Hessian callback +// expect error 'IntgrlHssEvl' + +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([2,0]) +mb.addvertex([0,2]) +mb.addvertex([2,2]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) +var m = mb.build() +m.addgrade(1) + +var l = FiniteElementSpace("CG1", grade=2) + +fn integrand(x, q) { + return hess(q).norm() +} + +var f = Field(m, fn (x,y) 3 - 4*x + 2*y, finiteelementspace=l) +print AreaIntegral(integrand, f, method={ }).total(m) diff --git a/test/field/discretizations/cg1_area_in_2d_old.morpho b/test/field/discretizations/cg1/cg1_area_in_2d_old.morpho similarity index 100% rename from test/field/discretizations/cg1_area_in_2d_old.morpho rename to test/field/discretizations/cg1/cg1_area_in_2d_old.morpho diff --git a/test/field/discretizations/cg1_line_in_3d_grad.morpho b/test/field/discretizations/cg1/cg1_line_in_3d_grad.morpho similarity index 100% rename from test/field/discretizations/cg1_line_in_3d_grad.morpho rename to test/field/discretizations/cg1/cg1_line_in_3d_grad.morpho diff --git a/test/field/discretizations/cg2_area_in_2d.morpho b/test/field/discretizations/cg2/cg2_area_in_2d.morpho similarity index 100% rename from test/field/discretizations/cg2_area_in_2d.morpho rename to test/field/discretizations/cg2/cg2_area_in_2d.morpho diff --git a/test/field/discretizations/cg2_area_in_2d_grad.morpho b/test/field/discretizations/cg2/cg2_area_in_2d_grad.morpho similarity index 100% rename from test/field/discretizations/cg2_area_in_2d_grad.morpho rename to test/field/discretizations/cg2/cg2_area_in_2d_grad.morpho diff --git a/test/field/discretizations/cg2/cg2_area_in_2d_hess.morpho b/test/field/discretizations/cg2/cg2_area_in_2d_hess.morpho new file mode 100644 index 000000000..2d040e6c5 --- /dev/null +++ b/test/field/discretizations/cg2/cg2_area_in_2d_hess.morpho @@ -0,0 +1,27 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addface([0,1,2]) +var m = mb.build() +m.addgrade(1) + +var l = FiniteElementSpace("CG2", grade=2) +var f = Field(m, fn (x,y) x^2 + x*y + 3*y^2, finiteelementspace=l) + +var out = true +var expected = Matrix([[2,1],[1,6]]) + +fn integrand(x, q) { + var h = hess(q) + if ((h-expected).norm() > 1e-8) out = false + return 0 +} + +print AreaIntegral(integrand, f, method={}).total(m) +// expect: 0 + +print out +// expect: true diff --git a/test/field/discretizations/cg2_area_in_2d_tensor_grad.morpho b/test/field/discretizations/cg2/cg2_area_in_2d_tensor_grad.morpho similarity index 100% rename from test/field/discretizations/cg2_area_in_2d_tensor_grad.morpho rename to test/field/discretizations/cg2/cg2_area_in_2d_tensor_grad.morpho diff --git a/test/field/discretizations/cg2/cg2_area_in_2d_tensor_hess.morpho b/test/field/discretizations/cg2/cg2_area_in_2d_tensor_hess.morpho new file mode 100644 index 000000000..d9bae48f0 --- /dev/null +++ b/test/field/discretizations/cg2/cg2_area_in_2d_tensor_hess.morpho @@ -0,0 +1,36 @@ +// Compute the hessian of a tensor + +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([2,0]) +mb.addvertex([0,2]) +mb.addvertex([2,2]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) +var m = mb.build() +m.addgrade(1) + +fn f0(x,y) { + return Matrix([[x^2 + x*y, y^2], [x*y, x^2 + 3*y^2]]) +} + +var f = Field(m, f0, finiteelementspace=FiniteElementSpace("CG2", grade=2)) + +var out = true + +fn integrand(x, q) { + var h = hess(q) + if ((h[0] - Matrix([[2,0],[0,2]])).norm() > 1e-8) out = false + if ((h[1] - Matrix([[1,0],[1,0]])).norm() > 1e-8) out = false + if ((h[2] - Matrix([[1,0],[1,0]])).norm() > 1e-8) out = false + if ((h[3] - Matrix([[0,2],[0,6]])).norm() > 1e-8) out = false + return 0 +} + +print AreaIntegral(integrand, f, method={ }).total(m) +// expect: 0 + +print out +// expect: true diff --git a/test/field/discretizations/cg2_area_in_3d_grad.morpho b/test/field/discretizations/cg2/cg2_area_in_3d_grad.morpho similarity index 100% rename from test/field/discretizations/cg2_area_in_3d_grad.morpho rename to test/field/discretizations/cg2/cg2_area_in_3d_grad.morpho diff --git a/test/field/discretizations/cg2_line_in_1d.morpho b/test/field/discretizations/cg2/cg2_line_in_1d.morpho similarity index 100% rename from test/field/discretizations/cg2_line_in_1d.morpho rename to test/field/discretizations/cg2/cg2_line_in_1d.morpho diff --git a/test/field/discretizations/cg2_line_in_2d_grad.morpho b/test/field/discretizations/cg2/cg2_line_in_2d_grad.morpho similarity index 100% rename from test/field/discretizations/cg2_line_in_2d_grad.morpho rename to test/field/discretizations/cg2/cg2_line_in_2d_grad.morpho diff --git a/test/field/discretizations/cg2_line_in_3d_integrate.morpho b/test/field/discretizations/cg2/cg2_line_in_3d_integrate.morpho similarity index 100% rename from test/field/discretizations/cg2_line_in_3d_integrate.morpho rename to test/field/discretizations/cg2/cg2_line_in_3d_integrate.morpho diff --git a/test/field/discretizations/cg2_vol_in_3d.morpho b/test/field/discretizations/cg2/cg2_vol_in_3d.morpho similarity index 100% rename from test/field/discretizations/cg2_vol_in_3d.morpho rename to test/field/discretizations/cg2/cg2_vol_in_3d.morpho diff --git a/test/field/discretizations/cg2_vol_in_3d_grad.morpho b/test/field/discretizations/cg2/cg2_vol_in_3d_grad.morpho similarity index 100% rename from test/field/discretizations/cg2_vol_in_3d_grad.morpho rename to test/field/discretizations/cg2/cg2_vol_in_3d_grad.morpho diff --git a/test/field/discretizations/cg2/cg2_vol_in_3d_hess.morpho b/test/field/discretizations/cg2/cg2_vol_in_3d_hess.morpho new file mode 100644 index 000000000..42cabb78f --- /dev/null +++ b/test/field/discretizations/cg2/cg2_vol_in_3d_hess.morpho @@ -0,0 +1,32 @@ +// CG2 FunctionSpace hessian in three dimensions + +import meshtools + +var cube = [ [0,0,0], [1,0,0], [0,1,0], [1,1,0], + [0,0,1], [1,0,1], [0,1,1], [1,1,1] ] + +var pts = [] +for (x in cube) pts.append(Matrix(x)) + +var m = DelaunayMesh(pts) +m.addgrade(1) + +var fe = FiniteElementSpace("CG2", grade=3) +var f = Field(m, fn (x,y,z) x^2 + x*y + 3*y^2 + 2*x*z + 4*y*z + 5*z^2, finiteelementspace=fe) + +var out = true +var expected = Matrix([[2,1,2], + [1,6,4], + [2,4,10]]) + +fn integrand(x, q) { + var h = hess(q) + if ((h-expected).norm() > 1e-8) out = false + return 0 +} + +print VolumeIntegral(integrand, f, method={}).total(m) +// expect: 0 + +print out +// expect: true diff --git a/test/field/discretizations/cg3/cg3_area_in_2d.morpho b/test/field/discretizations/cg3/cg3_area_in_2d.morpho new file mode 100644 index 000000000..5fd4c0626 --- /dev/null +++ b/test/field/discretizations/cg3/cg3_area_in_2d.morpho @@ -0,0 +1,23 @@ +// CG3 FunctionSpace in two dimensions + +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addvertex([1,1]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) +var m = mb.build() +m.addgrade(1) + +var l = FiniteElementSpace("CG3", grade=2) + +var f = Field(m, fn (x,y) (x+y)^3, finiteelementspace=l) + +print f.shape() +// expect: [ 1, 2, 1 ] + +print abs(AreaIntegral(fn (x, phi) phi, f, method={ }).total(m)-3/2) < 1e-6 +// expect: true diff --git a/test/field/discretizations/cg3/cg3_area_in_2d_grad.morpho b/test/field/discretizations/cg3/cg3_area_in_2d_grad.morpho new file mode 100644 index 000000000..247770ef3 --- /dev/null +++ b/test/field/discretizations/cg3/cg3_area_in_2d_grad.morpho @@ -0,0 +1,24 @@ +// Compute the gradient of a CG3 quantity on triangles in 2D + +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addvertex([1,1]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) +var m = mb.build() +m.addgrade(1) + +var l = FiniteElementSpace("CG3", grade=2) + +fn integrand(x, q) { + var g = grad(q) + return g.norm()^2 +} + +var f = Field(m, fn (x,y) x^3 + y^3, finiteelementspace=l) +print abs(AreaIntegral(integrand, f, method={ }).total(m) - 18/5) < 1e-8 +// expect: true diff --git a/test/field/discretizations/cg3/cg3_area_in_2d_hess.morpho b/test/field/discretizations/cg3/cg3_area_in_2d_hess.morpho new file mode 100644 index 000000000..a9edb436d --- /dev/null +++ b/test/field/discretizations/cg3/cg3_area_in_2d_hess.morpho @@ -0,0 +1,28 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addface([0,1,2]) +var m = mb.build() +m.addgrade(1) + +var l = FiniteElementSpace("CG3", grade=2) +var f = Field(m, fn (x,y) x^3 + 2*x^2*y + 3*x*y^2 + 4*y^3, finiteelementspace=l) + +var out = true + +fn integrand(x, q) { + var h = hess(q) + var ex = Matrix([[6*x[0] + 4*x[1], 4*x[0] + 6*x[1]], + [4*x[0] + 6*x[1], 6*x[0] + 24*x[1]]]) + if ((h-ex).norm() > 1e-8) out = false + return 0 +} + +print AreaIntegral(integrand, f, method={}).total(m) +// expect: 0 + +print out +// expect: true diff --git a/test/field/discretizations/cg3/cg3_area_in_2d_reversed_edge.morpho b/test/field/discretizations/cg3/cg3_area_in_2d_reversed_edge.morpho new file mode 100644 index 000000000..5deb1e9be --- /dev/null +++ b/test/field/discretizations/cg3/cg3_area_in_2d_reversed_edge.morpho @@ -0,0 +1,47 @@ +// CG3 FunctionSpace in two dimensions with a shared edge used in opposite local orientations + +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addvertex([1,1]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) +var m = mb.build() +m.addgrade(1) + +var l = FiniteElementSpace("CG3", grade=2) + +var f = Field(m, fn (x,y) x^3, finiteelementspace=l) + +print l.layout(f) +// expect: [ 1 0 ] +// expect: [ 1 1 ] +// expect: [ 1 1 ] +// expect: [ 0 1 ] +// expect: [ 1 0 ] +// expect: [ 1 0 ] +// expect: [ 1 0 ] +// expect: [ 1 0 ] +// expect: [ 1 1 ] +// expect: [ 1 1 ] +// expect: [ 0 1 ] +// expect: [ 0 1 ] +// expect: [ 0 1 ] +// expect: [ 0 1 ] +// expect: [ 1 0 ] +// expect: [ 0 1 ] + +print f.shape() +// expect: [ 1, 2, 1 ] + +// Shared edge is edge 2; these two values distinguish the edge orientation. +print abs(f[1,2,0]-8/27) < 1e-10 +// expect: true +print abs(f[1,2,1]-1/27) < 1e-10 +// expect: true + +print abs(AreaIntegral(fn (x, phi) phi, f, method={ }).total(m)-1/4) < 1e-6 +// expect: true diff --git a/test/field/discretizations/cg3/cg3_area_in_3d_lower.morpho b/test/field/discretizations/cg3/cg3_area_in_3d_lower.morpho new file mode 100644 index 000000000..f59d2d4ca --- /dev/null +++ b/test/field/discretizations/cg3/cg3_area_in_3d_lower.morpho @@ -0,0 +1,35 @@ +// Check lowering a CG3 tetrahedral field to its boundary faces. + +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0, 0, 0]) +mb.addvertex([2, 0, 0]) +mb.addvertex([0, 3, 0]) +mb.addvertex([0, 0, 5]) +mb.addvolume([0, 1, 2, 3]) + +var m = mb.build() +m.addgrade(1) +m.addgrade(2) + +var bnd = Selection(m, boundary=true) + +var fe = FiniteElementSpace("CG3", grade=3) + +fn exact(x, y, z) { + return x^3 + 2*x^2*y + 3*x*y^2 + 5*y^3 + + 7*x^2*z + 11*x*y*z + 13*y^2*z + + 17*x*z^2 + 19*y*z^2 + 23*z^3 + + 29*x + 31*y + 37*z +} + +var f = Field(m, fn (x, y, z) exact(x, y, z), finiteelementspace=fe) + +var err = AreaIntegral(fn (x, q) { + var ex = exact(x[0], x[1], x[2]) + return (q-ex)^2 +}, f, method={}).total(m, bnd) + +print abs(err) < 1e-10 +// expect: true diff --git a/test/field/discretizations/cg3/cg3_line_in_1d.morpho b/test/field/discretizations/cg3/cg3_line_in_1d.morpho new file mode 100644 index 000000000..226df47e8 --- /dev/null +++ b/test/field/discretizations/cg3/cg3_line_in_1d.morpho @@ -0,0 +1,31 @@ +// CG3 FunctionSpace in one dimension + +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([0.5,0,0]) +mb.addvertex([1,0,0]) +mb.addedge([0,1]) +mb.addedge([1,2]) +var m = mb.build() + +var l = FiniteElementSpace("CG3", grade=1) + +var f = Field(m, fn (x,y,z) x^3, finiteelementspace=l) + +print l.layout(f) +// expect: [ 1 0 ] +// expect: [ 1 1 ] +// expect: [ 0 1 ] +// expect: [ 1 0 ] +// expect: [ 1 0 ] +// expect: [ 0 1 ] +// expect: [ 0 1 ] + +print f.shape() +// expect: [ 1, 2 ] + +print (LineIntegral(fn (x, u) u, f, method={ }).total(m) - 1/4) < 1e-10 +// expect: true + diff --git a/test/field/discretizations/cg3/cg3_line_in_1d_hess.morpho b/test/field/discretizations/cg3/cg3_line_in_1d_hess.morpho new file mode 100644 index 000000000..ffa79aa57 --- /dev/null +++ b/test/field/discretizations/cg3/cg3_line_in_1d_hess.morpho @@ -0,0 +1,25 @@ +// CG3 FunctionSpace hessian in one dimension + +import meshtools + +var m = LineMesh(fn (u) [u,0,0], 0..1:0.5) + +var fe = FiniteElementSpace("CG3", grade=1) +var f = Field(m, fn (x,y,z) x^3 + 2*x^2 + 3*x + 4, finiteelementspace=fe) + +var out = true + +fn integrand(x, q) { + var h = hess(q) + var ex = Matrix([[6*x[0] + 4, 0, 0], + [0, 0, 0], + [0, 0, 0]]) + if ((h-ex).norm() > 1e-8) out = false + return 0 +} + +print LineIntegral(integrand, f, method={}).total(m) +// expect: 0 + +print out +// expect: true diff --git a/test/field/discretizations/cg3/cg3_line_in_1d_reversed.morpho b/test/field/discretizations/cg3/cg3_line_in_1d_reversed.morpho new file mode 100644 index 000000000..09190b011 --- /dev/null +++ b/test/field/discretizations/cg3/cg3_line_in_1d_reversed.morpho @@ -0,0 +1,31 @@ +// CG3 FunctionSpace in one dimension with a reversed edge orientation +// Smoke test only: true edge reorientation is exercised in higher-dimensional parents. + +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([0.5,0,0]) +mb.addvertex([1,0,0]) +mb.addedge([0,1]) +mb.addedge([2,1]) +var m = mb.build() + +var l = FiniteElementSpace("CG3", grade=1) + +var f = Field(m, fn (x,y,z) x^3, finiteelementspace=l) + +print l.layout(f) +// expect: [ 1 0 ] +// expect: [ 1 1 ] +// expect: [ 0 1 ] +// expect: [ 1 0 ] +// expect: [ 1 0 ] +// expect: [ 0 1 ] +// expect: [ 0 1 ] + +print f.shape() +// expect: [ 1, 2 ] + +print (LineIntegral(fn (x, u) u, f, method={ }).total(m) - 1/4) < 1e-10 +// expect: true diff --git a/test/field/discretizations/cg3/cg3_line_in_1d_triangle.morpho b/test/field/discretizations/cg3/cg3_line_in_1d_triangle.morpho new file mode 100644 index 000000000..6f8c620eb --- /dev/null +++ b/test/field/discretizations/cg3/cg3_line_in_1d_triangle.morpho @@ -0,0 +1,34 @@ +// CG3 FunctionSpace in one dimension on a triangle + +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addedge([0,1]) +mb.addedge([1,2]) +mb.addedge([2,0]) +var m = mb.build() + +var l = FiniteElementSpace("CG3", grade=1) + +var f = Field(m, fn (x,y,z) x^3 + y^3, finiteelementspace=l) + +print l.layout(f) +// expect: [ 1 0 1 ] +// expect: [ 1 1 0 ] +// expect: [ 0 1 1 ] +// expect: [ 1 0 0 ] +// expect: [ 1 0 0 ] +// expect: [ 0 1 0 ] +// expect: [ 0 1 0 ] +// expect: [ 0 0 1 ] +// expect: [ 0 0 1 ] + +print f.shape() +// expect: [ 1, 2 ] + +var a = 1/2 + 1/sqrt(2) +print abs(LineIntegral(fn (x, u) u, f, method={ }).total(m) - a) < 1e-10 +// expect: true diff --git a/test/field/discretizations/cg3/cg3_line_in_2d_grad.morpho b/test/field/discretizations/cg3/cg3_line_in_2d_grad.morpho new file mode 100644 index 000000000..b88847278 --- /dev/null +++ b/test/field/discretizations/cg3/cg3_line_in_2d_grad.morpho @@ -0,0 +1,17 @@ +// Compute the gradient of a CG3 quantity on a line in 2D + +import meshtools + +var m = LineMesh(fn (t) [t,t], 0..1:0.5) + +var l = FiniteElementSpace("CG3", grade=1) + +var f = Field(m, fn (x,y) x^3+y^3, finiteelementspace=l) + +fn integrand(x, u) { + var g = grad(u) + return g.norm()^2 +} + +print abs(LineIntegral(integrand, f, method={ }).total(m) - 18*sqrt(2)/5) < 1e-8 +// expect: true diff --git a/test/field/discretizations/cg3/cg3_nodecoords.morpho b/test/field/discretizations/cg3/cg3_nodecoords.morpho new file mode 100644 index 000000000..7151535f6 --- /dev/null +++ b/test/field/discretizations/cg3/cg3_nodecoords.morpho @@ -0,0 +1,17 @@ +// FiniteElementSpace nodeCoords methods + +var l = FiniteElementSpace("CG3", grade=2) + +var nodes = l.nodeCoords() + +print nodes.dimensions() +// expect: (3, 10) + +print (nodes.column(0) - Matrix([1,0,0])).norm() < 1e-12 +// expect: true + +print (nodes.column(9) - Matrix([1/3,1/3,1/3])).norm() < 1e-12 +// expect: true + +print (l.nodeCoords(3) - Matrix([2/3,1/3,0])).norm() < 1e-12 +// expect: true diff --git a/test/field/discretizations/cg3/cg3_vol_in_3d.morpho b/test/field/discretizations/cg3/cg3_vol_in_3d.morpho new file mode 100644 index 000000000..02760ab17 --- /dev/null +++ b/test/field/discretizations/cg3/cg3_vol_in_3d.morpho @@ -0,0 +1,29 @@ +// CG3 FunctionSpace in three dimensions + +import meshtools + +var cube = [ [0,0,0], [1,0,0], [0,1,0], [1,1,0], + [0,0,1], [1,0,1], [0,1,1], [1,1,1] ] + +var pts = [] +for (x in cube) pts.append(Matrix(x)) + +var m = DelaunayMesh(pts) +m.addgrade(1) + +var fe = FiniteElementSpace("CG3", grade=3) + +var f = Field(m, fn (x,y,z) x*y*z, finiteelementspace=fe) +print f.shape() +// expect: [ 1, 2, 1, 0 ] + +print abs(VolumeIntegral(fn (x, q) q, f, method={}).total(m) - 0.125) < 1e-8 +// expect: true + +var g = Field(m, fn (x,y,z) x^2*(y+z), finiteelementspace=fe) +print abs(VolumeIntegral(fn (x, q) q, g, method={}).total(m) - 1/3) < 1e-8 +// expect: true + +var h = Field(m, fn (x,y,z) z^3-x^2-y, finiteelementspace=fe) +print abs(VolumeIntegral(fn (x, q) q, h, method={}).total(m) - (-7/12)) < 1e-8 +// expect: true diff --git a/test/field/discretizations/cg3/cg3_vol_in_3d_grad.morpho b/test/field/discretizations/cg3/cg3_vol_in_3d_grad.morpho new file mode 100644 index 000000000..c1cec39c5 --- /dev/null +++ b/test/field/discretizations/cg3/cg3_vol_in_3d_grad.morpho @@ -0,0 +1,27 @@ +// CG3 FunctionSpace gradient in three dimensions + +import meshtools + +var cube = [ [0,0,0], [1,0,0], [0,1,0], [1,1,0], + [0,0,1], [1,0,1], [0,1,1], [1,1,1] ] + +var pts = [] +for (x in cube) pts.append(Matrix(x)) + +var m = DelaunayMesh(pts) +m.addgrade(1) + +var fe = FiniteElementSpace("CG3", grade=3) + +fn normsq(x, q) { + var g = grad(q) + return g.norm()^2 +} + +var f = Field(m, fn (x,y,z) x^3 + y^3 + z^3, finiteelementspace=fe) +print abs(VolumeIntegral(normsq, f, method={}).total(m) - 27/5) < 1e-6 +// expect: true + +f = Field(m, fn (x,y,z) x*y*z, finiteelementspace=fe) +print abs(VolumeIntegral(normsq, f, method={}).total(m) - 1/3) < 1e-6 +// expect: true diff --git a/test/field/discretizations/cg3/cg3_vol_in_3d_hess.morpho b/test/field/discretizations/cg3/cg3_vol_in_3d_hess.morpho new file mode 100644 index 000000000..4832a07ed --- /dev/null +++ b/test/field/discretizations/cg3/cg3_vol_in_3d_hess.morpho @@ -0,0 +1,32 @@ +// CG3 FunctionSpace hessian in three dimensions + +import meshtools + +var cube = [ [0,0,0], [1,0,0], [0,1,0], [1,1,0], + [0,0,1], [1,0,1], [0,1,1], [1,1,1] ] + +var pts = [] +for (x in cube) pts.append(Matrix(x)) + +var m = DelaunayMesh(pts) +m.addgrade(1) + +var fe = FiniteElementSpace("CG3", grade=3) +var f = Field(m, fn (x,y,z) x^3 + 2*x*y*z + z^3, finiteelementspace=fe) + +var out = true + +fn integrand(x, q) { + var h = hess(q) + var ex = Matrix([[6*x[0], 2*x[2], 2*x[1]], + [2*x[2], 0, 2*x[0]], + [2*x[1], 2*x[0], 6*x[2]]]) + if ((h-ex).norm() > 1e-8) out = false + return 0 +} + +print VolumeIntegral(integrand, f, method={}).total(m) +// expect: 0 + +print out +// expect: true diff --git a/test/field/discretizations/cg3/cg3_vol_in_3d_stress.morpho b/test/field/discretizations/cg3/cg3_vol_in_3d_stress.morpho new file mode 100644 index 000000000..cd07b005a --- /dev/null +++ b/test/field/discretizations/cg3/cg3_vol_in_3d_stress.morpho @@ -0,0 +1,26 @@ +// CG3 stress test in three dimensions: +// one function should be represented exactly, one should not. + +import meshtools + +var cube = [ [0,0,0], [1,0,0], [0,1,0], [1,1,0], + [0,0,1], [1,0,1], [0,1,1], [1,1,1] ] + +var pts = [] +for (x in cube) pts.append(Matrix(x)) + +var m = DelaunayMesh(pts) +m.addgrade(1) + +var fe = FiniteElementSpace("CG3", grade=3) + +// Exact: cubic polynomial +var exact = Field(m, fn (x,y,z) x^3 + y^2*z, finiteelementspace=fe) +print abs(VolumeIntegral(fn (x, q) q, exact, method={}).total(m) - (1/4 + 1/6)) < 1e-8 +// expect: true + +// Inexact: quartic polynomial +var inexact = Field(m, fn (x,y,z) x^4 + y^4 + z^4, finiteelementspace=fe) +print abs(VolumeIntegral(fn (x, q) q, inexact, method={}).total(m) - 3/5) > 1e-8 +// expect: true + diff --git a/test/field/element_dofs.morpho b/test/field/element_dofs.morpho new file mode 100644 index 000000000..ea99dd22b --- /dev/null +++ b/test/field/element_dofs.morpho @@ -0,0 +1,41 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addface([0,1,2]) +var m = mb.build() +m.addgrade(1) + +var cg3 = FiniteElementSpace("CG3", grade=2) +var f = Field(m, fn (x,y) (x+y)^3, finiteelementspace=cg3) +var dofs = f.elementDofs(0) + +print dofs.count() +// expect: 10 + +print dofs[0] +// expect: (0, 0, 0) +print dofs[1] +// expect: (0, 1, 0) +print dofs[2] +// expect: (0, 2, 0) + +print dofs[3] +// expect: (1, 0, 0) +print dofs[4] +// expect: (1, 0, 1) + +print dofs[5] +// expect: (1, 2, 0) +print dofs[6] +// expect: (1, 2, 1) + +print dofs[7] +// expect: (1, 1, 1) +print dofs[8] +// expect: (1, 1, 0) + +print dofs[9] +// expect: (2, 0, 0) diff --git a/test/field/element_dofs_3d_cg2.morpho b/test/field/element_dofs_3d_cg2.morpho new file mode 100644 index 000000000..65609ea66 --- /dev/null +++ b/test/field/element_dofs_3d_cg2.morpho @@ -0,0 +1,33 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvolume([0,1,2,3]) +var m = mb.build() +m.addgrade(1) +m.addgrade(2) +m.addgrade(3) + +var cg2 = FiniteElementSpace("CG2", grade=3) +var f = Field(m, fn (x,y,z) x^2 + y*z - z, finiteelementspace=cg2) +var dofs = f.elementDofs(0) + +var counts = [0, 0, 0, 0] +var seen = Dictionary() +for (dof in dofs) { + counts[dof[0]] += 1 + seen[dof] = true +} + +print dofs.count() +// expect: 10 + +print counts +// expect: [ 4, 6, 0, 0 ] + +print seen.count() +// expect: 10 + diff --git a/test/field/element_dofs_3d_cg3.morpho b/test/field/element_dofs_3d_cg3.morpho new file mode 100644 index 000000000..3d9da367a --- /dev/null +++ b/test/field/element_dofs_3d_cg3.morpho @@ -0,0 +1,33 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvolume([0,1,2,3]) +var m = mb.build() +m.addgrade(1) +m.addgrade(2) +m.addgrade(3) + +var cg3 = FiniteElementSpace("CG3", grade=3) +var f = Field(m, fn (x,y,z) x^3 - x*y + 2*y*z + z^2, finiteelementspace=cg3) +var dofs = f.elementDofs(0) + +var counts = [0, 0, 0, 0] +var seen = Dictionary() +for (dof in dofs) { + counts[dof[0]] += 1 + seen[dof] = true +} + +print dofs.count() +// expect: 20 + +print counts +// expect: [ 4, 12, 4, 0 ] + +print seen.count() +// expect: 20 + diff --git a/test/field/eval_element.morpho b/test/field/eval_element.morpho new file mode 100644 index 000000000..f41bf8460 --- /dev/null +++ b/test/field/eval_element.morpho @@ -0,0 +1,27 @@ +// Field evalElement method + +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addface([0,1,2]) +var m = mb.build() +m.addgrade(1) + +var cg3 = FiniteElementSpace("CG3", grade=2) +var f = Field(m, fn (x,y) (x+y)^3, finiteelementspace=cg3) + +print abs(f.evalElement(0, [1/3,1/3,1/3]) - 8/27) < 1e-10 +// expect: true + +print abs(f.evalElement(0, cg3.nodeCoords(9)) - 8/27) < 1e-10 +// expect: true + +var cg2 = FiniteElementSpace("CG2", grade=2) +var g = Field(m, fn (x,y) Matrix([[x,y],[-y,x]]), finiteelementspace=cg2) +var val = g.evalElement(0, [1/2,1/4,1/4]) + +print (val - Matrix([[1/4,1/4],[-1/4,1/4]])).norm() < 1e-10 +// expect: true diff --git a/test/function/optimizable_entry.morpho b/test/function/optimizable_entry.morpho new file mode 100644 index 000000000..e59b51cb4 --- /dev/null +++ b/test/function/optimizable_entry.morpho @@ -0,0 +1,16 @@ +fn f(x) { + if (true) { + // entry block becomes empty after folding + } else { + return 99 + } + + var i = 0 + while (i < 3) { + i = i + 1 + } + + return i +} + +print f(0) // expect: 3 \ No newline at end of file diff --git a/test/functionals/areaintegral/jacobian.morpho b/test/functionals/areaintegral/jacobian.morpho new file mode 100644 index 000000000..5ad1bd929 --- /dev/null +++ b/test/functionals/areaintegral/jacobian.morpho @@ -0,0 +1,33 @@ +// Test the jacobian() function + +import meshtools + +// Create the reference triangle +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addedge([0,1]) +mb.addedge([1,2]) +mb.addedge([2,0]) +mb.addface([0,1,2]) + +var mref = mb.build() + +// Make the target triangle by cloning the reference.. +var m = mref.clone() +m.setvertexmatrix(2*m.vertexmatrix()) // ... and scaling by 2 + +fn integrand(x) { + var F = jacobian() + //var Jinv = invjacobian() + var Ft = F.transpose() + + return (F*Ft).trace() +} + +var a=AreaIntegral(integrand, reference=mref, weightByReference=true).total(m) + +print a +// expect: 4 +// because Tr(F*Ft)=8; and the area of the reference tri. is 1/2 diff --git a/test/functionals/areaintegral/tangent.morpho b/test/functionals/areaintegral/tangent.morpho new file mode 100644 index 000000000..c30f8c5ab --- /dev/null +++ b/test/functionals/areaintegral/tangent.morpho @@ -0,0 +1,9 @@ +import constants +import meshtools + +var m = AreaMesh(fn (x,y) [x,y,0], 0..1:0.5, 0..1:0.5) + +var f = Field(m, fn (x,y,z) Matrix([0,0,1])) + +print AreaIntegral(fn (x, n) n.inner(tangent())^2 , f).total(m) +// expect error 'TngntGrade' diff --git a/test/functionals/err_integrand.morpho b/test/functionals/err_integrand.morpho index e155366e7..59f52125c 100644 --- a/test/functionals/err_integrand.morpho +++ b/test/functionals/err_integrand.morpho @@ -19,4 +19,4 @@ var defectsGrad = Field(m, fn(x,y,z) phdgrad(x, y, z, 0.25, 0, 0)+mhdgrad(x, y, var directorIntegral = LineIntegral(fn (x,n) 1/(2*Pi) * n.inner(tangent()), defectsGrad) var fe = directorIntegral.integrand(m) -//expect error 'MtrxIncmptbl' \ No newline at end of file +//expect error 'LnAlgMtrxIncmptbl' \ No newline at end of file diff --git a/test/functionals/hydrogel/hydrogel2D.morpho b/test/functionals/hydrogel/hydrogel2D.morpho index ead6733af..48ffb5752 100644 --- a/test/functionals/hydrogel/hydrogel2D.morpho +++ b/test/functionals/hydrogel/hydrogel2D.morpho @@ -32,7 +32,7 @@ var m = mb.build() // Expand m by a linear factor var f = 1.2 var vert = m.vertexmatrix() -for (i in 0...m.count()) m.setvertexposition(i, f*vert.column(i)) +for (i in 0...m.count()) m.setvertexposition(i, vert.column(i)*f) var phi = phi0/(f^2) // New phi will be inversely proportional to the area var vol = vol0 * f^2 diff --git a/test/functionals/jump/jump1d.morpho b/test/functionals/jump/jump1d.morpho new file mode 100644 index 000000000..2a6690d4c --- /dev/null +++ b/test/functionals/jump/jump1d.morpho @@ -0,0 +1,9 @@ +import meshtools + +var m = LineMesh(fn (u) [u,0,0], 0..1:0.5) + +var fe = FiniteElementSpace("CG1", grade=1) +var f = Field(m, fn (x,y,z) x^2, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "centroid" }).total(m) - 1) < 1e-8 +// expect: true diff --git a/test/functionals/jump/jump1d_quadrature.morpho b/test/functionals/jump/jump1d_quadrature.morpho new file mode 100644 index 000000000..1b239cc4c --- /dev/null +++ b/test/functionals/jump/jump1d_quadrature.morpho @@ -0,0 +1,9 @@ +import meshtools + +var m = LineMesh(fn (u) [u,0,0], 0..1:0.5) + +var fe = FiniteElementSpace("CG1", grade=1) +var f = Field(m, fn (x,y,z) x^2, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "quadrature" }).total(m) - 1) < 1e-8 +// expect: true diff --git a/test/functionals/jump/jump2d.morpho b/test/functionals/jump/jump2d.morpho new file mode 100644 index 000000000..b703bd81e --- /dev/null +++ b/test/functionals/jump/jump2d.morpho @@ -0,0 +1,18 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([1,1,0]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) + +var m = mb.build() +m.addgrade(1) + +var fe = FiniteElementSpace("CG1", grade=2) +var f = Field(m, fn (x,y,z) x*y, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "centroid" }).total(m) - 2*sqrt(2)) < 1e-8 +// expect: true diff --git a/test/functionals/jump/jump2d_cg2.morpho b/test/functionals/jump/jump2d_cg2.morpho new file mode 100644 index 000000000..1e60cc77c --- /dev/null +++ b/test/functionals/jump/jump2d_cg2.morpho @@ -0,0 +1,18 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([1,1,0]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) + +var m = mb.build() +m.addgrade(1) + +var fe = FiniteElementSpace("CG2", grade=2) +var f = Field(m, fn (x,y,z) x*y^2, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "centroid" }).total(m) - 0) < 1e-8 +// expect: true diff --git a/test/functionals/jump/jump2d_cg2_quadrature.morpho b/test/functionals/jump/jump2d_cg2_quadrature.morpho new file mode 100644 index 000000000..147587279 --- /dev/null +++ b/test/functionals/jump/jump2d_cg2_quadrature.morpho @@ -0,0 +1,18 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([1,1,0]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) + +var m = mb.build() +m.addgrade(1) + +var fe = FiniteElementSpace("CG2", grade=2) +var f = Field(m, fn (x,y,z) x*y^2, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "quadrature" }).total(m) - 0.23570226039551584) < 1e-8 +// expect: true diff --git a/test/functionals/jump/jump2d_cg3.morpho b/test/functionals/jump/jump2d_cg3.morpho new file mode 100644 index 000000000..1c1549cb3 --- /dev/null +++ b/test/functionals/jump/jump2d_cg3.morpho @@ -0,0 +1,18 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([1,1,0]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) + +var m = mb.build() +m.addgrade(1) + +var fe = FiniteElementSpace("CG3", grade=2) +var f = Field(m, fn (x,y,z) x^3*y, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "centroid" }).total(m) - 0.00218242836478002) < 1e-8 +// expect: true diff --git a/test/functionals/jump/jump2d_cg3_gradient.morpho b/test/functionals/jump/jump2d_cg3_gradient.morpho new file mode 100644 index 000000000..08f8117b5 --- /dev/null +++ b/test/functionals/jump/jump2d_cg3_gradient.morpho @@ -0,0 +1,25 @@ +import meshtools +import "../numericalderivatives.morpho" + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([1,1,0]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) + +var m = mb.build() +m.addgrade(1) + +var fe = FiniteElementSpace("CG3", grade=2) +var f = Field(m, fn (x,y,z) x^3*y, finiteelementspace=fe) + +var j = Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "quadrature" }) +var tol = 2e-5 + +print (j.gradient(m) - numericalgradient(j, m)).norm() < tol +// expect: true + +print (j.fieldgradient(m, f) - numericalfieldgradient(j, m, f)).linearize().norm() < tol +// expect: true diff --git a/test/functionals/jump/jump2d_cg3_quadrature.morpho b/test/functionals/jump/jump2d_cg3_quadrature.morpho new file mode 100644 index 000000000..d950f0b59 --- /dev/null +++ b/test/functionals/jump/jump2d_cg3_quadrature.morpho @@ -0,0 +1,18 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([1,1,0]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) + +var m = mb.build() +m.addgrade(1) + +var fe = FiniteElementSpace("CG3", grade=2) +var f = Field(m, fn (x,y,z) x^3*y, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "quadrature" }).total(m) - 0.024443198339536116) < 1e-8 +// expect: true diff --git a/test/functionals/jump/jump2d_cg3_wave_diagnostics.morpho b/test/functionals/jump/jump2d_cg3_wave_diagnostics.morpho new file mode 100644 index 000000000..066d18c58 --- /dev/null +++ b/test/functionals/jump/jump2d_cg3_wave_diagnostics.morpho @@ -0,0 +1,60 @@ +// Diagnostic cross-checks for the CG3 wave/jump penalty setup. +// +// This test is not an optimization run. It checks three things on the +// same flat embedded 2D mesh used by the wave penalty tests: +// 1. the exact wave satisfies the intended Helmholtz-like bulk operator; +// 2. the transverse perturbation excites the jump penalty more than the +// exact wave alone; +// 3. the combined field has larger bulk residual and jump penalty than +// the exact wave. + +import meshtools + +var m = AreaMesh(fn (x, y) [x, y, 0], 0..1:0.2, 0..1:0.2) + +var fe = FiniteElementSpace("CG3", grade=2) + +var qwave = Field(m, fn (x, y, z) sin(Pi*x), finiteelementspace=fe) +var qpert = Field(m, fn (x, y, z) 0.02*sin(3*Pi*x)*cos(2*Pi*y), finiteelementspace=fe) +var qmix = Field(m, fn (x, y, z) sin(Pi*x) + 0.02*sin(3*Pi*x)*cos(2*Pi*y), finiteelementspace=fe) + +var target = Matrix([[Pi^2, 0, 0], + [0, 0, 0], + [0, 0, 0]]) + +fn bulkintegrand(x, q) { + return (hess(q)+q*target).norm()^2 +} + +var bulkWave = AreaIntegral(bulkintegrand, qwave, method={}) +var bulkPert = AreaIntegral(bulkintegrand, qpert, method={}) +var bulkMix = AreaIntegral(bulkintegrand, qmix, method={}) + +var jumpWave = Jump(fn (x, q) jumpdn(q)^2, qwave, method={ "strategy": "quadrature" }) +var jumpPert = Jump(fn (x, q) jumpdn(q)^2, qpert, method={ "strategy": "quadrature" }) +var jumpMix = Jump(fn (x, q) jumpdn(q)^2, qmix, method={ "strategy": "quadrature" }) + +var bulkWaveVal = bulkWave.total(m) +var bulkPertVal = bulkPert.total(m) +var bulkMixVal = bulkMix.total(m) + +var jumpWaveVal = jumpWave.total(m) +var jumpPertVal = jumpPert.total(m) +var jumpMixVal = jumpMix.total(m) + +/*print "bulk(wave) = ${bulkWaveVal}" +print "bulk(pert) = ${bulkPertVal}" +print "bulk(mix) = ${bulkMixVal}" + +print "jump(wave) = ${jumpWaveVal}" +print "jump(pert) = ${jumpPertVal}" +print "jump(mix) = ${jumpMixVal}"*/ + +var ok = true +if (!(bulkPertVal > 10*bulkWaveVal)) ok = false +if (!(bulkMixVal > 10*bulkWaveVal)) ok = false +if (!(jumpPertVal > 3*jumpWaveVal)) ok = false +if (!(jumpMixVal > jumpPertVal)) ok = false + +print ok +// expect: true diff --git a/test/functionals/jump/jump2d_quadrature.morpho b/test/functionals/jump/jump2d_quadrature.morpho new file mode 100644 index 000000000..8b84f9ac5 --- /dev/null +++ b/test/functionals/jump/jump2d_quadrature.morpho @@ -0,0 +1,18 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([1,1,0]) +mb.addface([0,1,2]) +mb.addface([1,3,2]) + +var m = mb.build() +m.addgrade(1) + +var fe = FiniteElementSpace("CG1", grade=2) +var f = Field(m, fn (x,y,z) x*y, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "quadrature" }).total(m) - 2*sqrt(2)) < 1e-8 +// expect: true diff --git a/test/functionals/jump/jump3d.morpho b/test/functionals/jump/jump3d.morpho new file mode 100644 index 000000000..e497fcceb --- /dev/null +++ b/test/functionals/jump/jump3d.morpho @@ -0,0 +1,20 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvertex([0,0,-1]) +mb.addvolume([0,1,2,3]) +mb.addvolume([0,1,2,4]) + +var m = mb.build() +m.addgrade(1) +m.addgrade(2) + +var fe = FiniteElementSpace("CG1", grade=3) +var f = Field(m, fn (x,y,z) z^2, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "centroid" }).total(m) - 2) < 1e-8 +// expect: true diff --git a/test/functionals/jump/jump3d_cg3_gradient.morpho b/test/functionals/jump/jump3d_cg3_gradient.morpho new file mode 100644 index 000000000..20acb3290 --- /dev/null +++ b/test/functionals/jump/jump3d_cg3_gradient.morpho @@ -0,0 +1,27 @@ +import meshtools +import "../numericalderivatives.morpho" + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvertex([0,0,-1]) +mb.addvolume([0,1,2,3]) +mb.addvolume([0,1,2,4]) + +var m = mb.build() +m.addgrade(1) +m.addgrade(2) + +var fe = FiniteElementSpace("CG3", grade=3) +var f = Field(m, fn (x,y,z) x*y*z^2, finiteelementspace=fe) + +var j = Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "quadrature" }) +var tol = 2e-5 + +print (j.gradient(m) - numericalgradient(j, m)).norm() < tol +// expect: true + +print (j.fieldgradient(m, f) - numericalfieldgradient(j, m, f)).linearize().norm() < tol +// expect: true diff --git a/test/functionals/jump/jump3d_cg3_quadrature.morpho b/test/functionals/jump/jump3d_cg3_quadrature.morpho new file mode 100644 index 000000000..d334d45a0 --- /dev/null +++ b/test/functionals/jump/jump3d_cg3_quadrature.morpho @@ -0,0 +1,20 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvertex([0,0,-1]) +mb.addvolume([0,1,2,3]) +mb.addvolume([0,1,2,4]) + +var m = mb.build() +m.addgrade(1) +m.addgrade(2) + +var fe = FiniteElementSpace("CG3", grade=3) +var f = Field(m, fn (x,y,z) x*y*z^2, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "quadrature" }).total(m) - 1/405) < 1e-8 +// expect: true diff --git a/test/functionals/jump/jump3d_quadrature.morpho b/test/functionals/jump/jump3d_quadrature.morpho new file mode 100644 index 000000000..d08b6cad5 --- /dev/null +++ b/test/functionals/jump/jump3d_quadrature.morpho @@ -0,0 +1,20 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvertex([0,0,-1]) +mb.addvolume([0,1,2,3]) +mb.addvolume([0,1,2,4]) + +var m = mb.build() +m.addgrade(1) +m.addgrade(2) + +var fe = FiniteElementSpace("CG1", grade=3) +var f = Field(m, fn (x,y,z) z^2, finiteelementspace=fe) + +print abs(Jump(fn (x, q) jumpdn(q)^2, f, method={ "strategy": "quadrature" }).total(m) - 2) < 1e-8 +// expect: true diff --git a/test/functionals/lineintegral/normal.morpho b/test/functionals/lineintegral/normal.morpho new file mode 100644 index 000000000..99c51ff09 --- /dev/null +++ b/test/functionals/lineintegral/normal.morpho @@ -0,0 +1,12 @@ +import constants +import meshtools + +var m = LineMesh(fn (t) [cos(t),sin(t),0], 0..Pi:Pi/10) + +var nn = Field(m, fn (x,y,z) Matrix([1,0,0])) + +// A line integral with a element call +var lc = LineIntegral(fn (x, n) (n.inner(normal()))^2, nn) + +print lc.integrand(m) +// expect error 'NormlGrade' \ No newline at end of file diff --git a/test/functionals/smectic/fieldprojector.xmorpho b/test/functionals/smectic/fieldprojector.xmorpho new file mode 100644 index 000000000..78bdd5bf2 --- /dev/null +++ b/test/functionals/smectic/fieldprojector.xmorpho @@ -0,0 +1,70 @@ + +import optimize4 + +class FieldProjector { + init(Field field, maxIterations=1000) { + self.field = field + if (!field.finiteElementSpace()) Error("FldPrjNoFES","Field must have finite element space").throw() + + self.maxIterations = maxIterations + self.mesh = self.field.mesh() + self.grade = field.finiteElementSpace().grade() + if (self.grade<1 || self.grade>3) Error("FldPrjGrd","Unsupported field grade").throw() + + self.prototype = self.field.prototype() + if (isnil(self.prototype)) self.prototype = 0 + else self.prototype *= 0 + } + + _integralClass() { + var func = ( nil, LineIntegral, AreaIntegral, VolumeIntegral ) + return func[self.grade] + } + + _distanceSquared() { + if (isnumber(self.prototype)) return fn (x, u, v) { return (u-v)^2 } + else if (self.prototype.respondsto("norm")) return fn (x, u, v) { return (u-v).norm()^2 } + + Error("FldPrjFunc","Unsupported field contents").throw() + } + + _sourceNormSquared() { + if (isnumber(self.prototype)) return fn (x, u) { return u^2 } + else if (self.prototype.respondsto("norm")) return fn (x, u) { return u.norm()^2 } + + Error("FldPrjFunc","Unsupported field contents").throw() + } + + _setupProblem(Field target) { + self.problem = OptimizationProblem(self.field.mesh()) + self.problem.addenergy(self._integralClass()(self._distanceSquared(), self.field, target, method={})) + } + + _setTolerances(control, rtol=1e-8, gtol=1e-10) { + var integral = self._integralClass() + + var measure = integral(fn (x) 1, method={}).total(self.mesh) + var usq = integral(self._sourceNormSquared(), self.field, method={}).total(self.mesh) + + var uscale = 1.0 + if (measure>0 && usq>0) uscale = sqrt(usq/measure) + uscale = max(1.0, uscale) + + control.etol = 0.5*measure*(rtol*uscale)^2 + control.gradtol = gtol*uscale + } + + _optimize(Field target) { + var adapt = ProblemAdapter(self.problem, target) + var opt = LBFGSController(adapt, quiet=true) + self._setTolerances(opt) + opt.optimize(self.maxIterations) + } + + project(FiniteElementSpace fe) { + var target = Field(self.mesh, self.prototype, finiteelementspace=fe) + self._setupProblem(target) + self._optimize(target) + return target + } +} diff --git a/test/functionals/smectic/fieldprojectortest.xmorpho b/test/functionals/smectic/fieldprojectortest.xmorpho new file mode 100644 index 000000000..00cd3eb6c --- /dev/null +++ b/test/functionals/smectic/fieldprojectortest.xmorpho @@ -0,0 +1,72 @@ + +import meshtools +import "fieldprojector.xmorpho" + +fn point(lambda, vids, verts) { + var x = lambda[0]*verts.column(vids[0]) + for (j in 1...lambda.count()) x += lambda[j]*verts.column(vids[j]) + return x +} + +fn maxexacterror(field, exact) { + var mesh = field.mesh() + var fespace = field.finiteElementSpace() + var verts = mesh.vertexmatrix() + var conn = mesh.connectivitymatrix(0, fespace.grade()) + var nodes = fespace.nodeCoords() + var err = 0 + + for (id in 0...mesh.count(fespace.grade())) { + var vids = conn.rowindices(id) + for (i in 0...fespace.count()) { + var lambda = nodes.column(i) + var x = point(lambda, vids, verts) + var expected + if (x.count()==1) expected = apply(exact, x[0]) + else if (x.count()==2) expected = apply(exact, x[0], x[1]) + else expected = apply(exact, x[0], x[1], x[2]) + var val = field.evalElement(id, lambda) + + if (isnumber(val)) { + err = max(err, abs(val-expected)) + } else { + err = max(err, (val-expected).norm()) + } + } + } + + return err +} + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addface([0,1,2]) +var m = mb.build() +m.addgrade(1) + +fn exact(x, y) { + return 1 + 2*x - 3*y +} + +var cg1 = FiniteElementSpace("CG1", grade=2) +var cg3 = FiniteElementSpace("CG3", grade=2) + +var coarse = Field(m, exact, finiteelementspace=cg1) +var lifted = FieldProjector(coarse).project(cg3) +var liftederr = maxexacterror(lifted, exact) + +print lifted.shape()[0]==1 && lifted.shape()[1]==2 && lifted.shape()[2]==1 +// expect: true +print liftederr < 1e-5 +// expect: true + +var rich = Field(m, exact, finiteelementspace=cg3) +var reduced = FieldProjector(rich).project(cg1) +var reducederr = maxexacterror(reduced, exact) + +print reduced.shape()[0]==1 && reduced.shape()[1]==0 && reduced.shape()[2]==0 +// expect: truer +print reducederr < 1e-5 +// expect: true diff --git a/test/functionals/smectic/qtensortools.xmorpho b/test/functionals/smectic/qtensortools.xmorpho new file mode 100644 index 000000000..bb1f4877d --- /dev/null +++ b/test/functionals/smectic/qtensortools.xmorpho @@ -0,0 +1,122 @@ +// Tools to work with the Q-tensor in 3D. The Q-tensor is a symmetric traceless 3x3 matrix that describes the local orientational order of liquid crystals. + +import graphics + +// The q tensor [ Qxx Qxy Qxz ] +// [ Qxy Qyy Qyz ] +// [ Qxz Qyz Qzz ] +// is symmetric and traceless. Hence there are 5 independent components: [ Qxx, Qxy, Qxz, Qyy, Qyz ] +// We will represent these as a vector. + +// Reconstruct Q-tensor from the q-vector +fn reconstructQ(qv) { + return Matrix( [ [ qv[0], qv[1], qv[2] ], [ qv[1], qv[3], qv[4] ], [ qv[2], qv[4], -qv[0]-qv[3] ] ]) +} + +// Reconstruct q-vector from Q-tensor +fn reconstructqv(Q) { + return Matrix([ Q[0,0], Q[0,1], Q[0,2], Q[1,1], Q[1,2] ]) +} + +// Function to get the scalar order parameter S from the Q-tensor +fn qtoorder(qv) { + var Q = reconstructQ(qv) + var ev = Q.eigenvalues() + return max(ev) +} + +// Reconstruct director from Q-tensor +fn qtodirector(qv) { + var Q = reconstructQ(qv) + var es = Q.eigensystem() + var order = es[0].order() // Find largest eigenvalue + var n = es[1].column(order[-1]) // Return associated eigenvector + n/=n.norm() + return n +} + +// Construct a Q tensor from S and n +fn constructQ(S, n) { + return S*(n.outer(n) - IdentityMatrix(3)/3) +} + +// Converts a q-vector to a Q-tensor +fn qtensor(q) { + return Matrix([ [q[0], q[1], q[2]], + [q[1], q[3], q[4]], + [q[2], q[4], -q[0]-q[3]] ]) +} + +// Convert our Q vector Field to a Q tensor field +fn qfield(Q) { + var m = Q.mesh() + var qq = Field(m, qtensor(Q[0,0])) + for (id in 0...m.count(0)) qq[0,id] = qtensor(Q[0,id]) + return qq +} + +// Radial initial condition +fn radialQ(x,y,z) { + var S0 = 0.6 + var n = Matrix([x,y,z]) + if (n.norm()>1e-6) n/=n.norm() + + return S0*Matrix([ n[0]^2 - 1/3, + n[0]*n[1], + n[0]*n[2], + n[1]^2 - 1/3, + n[1]*n[2] ]) +} + +// Uniform initial condition +fn uniformQ(x,y,z) { + var S0 = 0.6 + var n = Matrix([1,0,0]) + return S0*Matrix([ n[0]^2 - 1/3, + n[0]*n[1], + n[0]*n[2], + n[1]^2 - 1/3, + n[1]*n[2] ]) +} + + +fn radialQ(x,y) { return radialQ(x,y,0) } + +// Calculates Fields from Q tensor for visualization purposes +fn qvis(Q) { + var m = Q.mesh() + var e0=Field(m), e1=Field(m), e2=Field(m) + var nn=Field(m, Matrix([1,0,0])) + + for (id in 0...m.count(0)) { + var q = qtensor(Q[0,id]) + var es=q.eigensystem() + var order=es[0].order() + e0[0,id]=es[0][order[-1]] + e1[0,id]=es[0][order[-2]] + e2[0,id]=es[0][order[-3]] + nn[0,id]=es[1].column(order[-1]) + } + + return [e0, e1, e2, nn] +} + +fn _promote(x, n) { + var y = Matrix(n) + for (i in 0...x.count()) y[i] = x[i] + return y +} + +// Visualizes a director field as cylinders. +fn visdirector(n, lambda) { + var m = n.mesh() + var g = Graphics() + for (vid in 0...m.count()) { + var nn=n[0,vid] + if (nn.norm()>1e-6) nn/=nn.norm() + var x = m.vertexposition(vid) + if (x.count()) + +print es[0] +// expect: (0 + 1im, 0 - 1im) + +// Compare to analytical eigenvectors +var v = ComplexMatrix(2,2) +v[0,0]=sqrt(2)/2 +v[1,0]=sqrt(2)/2 +v[0,1]=sqrt(2)/2 +v[1,1]=-sqrt(2)/2 + +print abs((es[1]-v).sum()) < 1e-15 +// expect: true diff --git a/test/linalg/methods/complexmatrix_eigenvalues.morpho b/test/linalg/methods/complexmatrix_eigenvalues.morpho new file mode 100644 index 000000000..74f858dc5 --- /dev/null +++ b/test/linalg/methods/complexmatrix_eigenvalues.morpho @@ -0,0 +1,10 @@ +// Eigenvalues + +var A = ComplexMatrix(2,2) +A[0,0]=0+0im +A[0,1]=im +A[1,0]=im +A[1,1]=0+0im + +print A.eigenvalues() +// expect: (0 + 1im, 0 - 1im) diff --git a/test/linalg/methods/complexmatrix_enumerate.morpho b/test/linalg/methods/complexmatrix_enumerate.morpho new file mode 100644 index 000000000..dcce14474 --- /dev/null +++ b/test/linalg/methods/complexmatrix_enumerate.morpho @@ -0,0 +1,13 @@ +// Enumerate elements of a matrix + +var A = ComplexMatrix(2,2) +A[0,0] = 1+im +A[0,1] = 0+0im +A[1,0] = 0+0im +A[1,1] = 1-im + +for (x in A) print x +// expect: 1 + 1im +// expect: 0 + 0im +// expect: 0 + 0im +// expect: 1 - 1im diff --git a/test/linalg/methods/complexmatrix_format.morpho b/test/linalg/methods/complexmatrix_format.morpho new file mode 100644 index 000000000..32d32dd9c --- /dev/null +++ b/test/linalg/methods/complexmatrix_format.morpho @@ -0,0 +1,12 @@ +// Format +import constants + +var A = ComplexMatrix(2,2) +A[0,0]=1+1im +A[0,1]=exp(im*Pi/4) +A[1,0]=exp(-im*Pi/4) +A[1,1]=-1.5*(1+1im) + +print A.format("%5.2f") +// expect: [ 1.00 + 1.00im 0.71 + 0.71im ] +// expect: [ 0.71 - 0.71im -1.50 - 1.50im ] diff --git a/test/linalg/methods/complexmatrix_imag.morpho b/test/linalg/methods/complexmatrix_imag.morpho new file mode 100644 index 000000000..26afc044c --- /dev/null +++ b/test/linalg/methods/complexmatrix_imag.morpho @@ -0,0 +1,11 @@ +// Inner product of ComplexMatrices (Frobenius inner product with conjugation) + +var A = ComplexMatrix(2,2) +A[0,0]=1+4im +A[0,1]=2+3im +A[1,0]=3+2im +A[1,1]=4+1im + +print A.imag() +// expect: [ 4 3 ] +// expect: [ 2 1 ] diff --git a/test/linalg/methods/complexmatrix_inner.morpho b/test/linalg/methods/complexmatrix_inner.morpho new file mode 100644 index 000000000..a86765099 --- /dev/null +++ b/test/linalg/methods/complexmatrix_inner.morpho @@ -0,0 +1,25 @@ +// Inner product of ComplexMatrices (Frobenius inner product with conjugation) + +var A = ComplexMatrix(2,2) +A[0,0]=1+1im +A[0,1]=2+2im +A[1,0]=3+3im +A[1,1]=4+4im + +var B = ComplexMatrix(2,2) +B[0,0]=1 +B[0,1]=1im +B[1,0]=-1im +B[1,1]=1 + +print A.inner(B) +// expect: 4 - 6im + +var C = Matrix(2,2) +C[0,0]=1 +C[0,1]=2 +C[1,0]=3 +C[1,1]=4 + +print A.inner(C) +// expect: 30 - 30im diff --git a/test/linalg/methods/complexmatrix_inverse.morpho b/test/linalg/methods/complexmatrix_inverse.morpho new file mode 100644 index 000000000..b13fc2628 --- /dev/null +++ b/test/linalg/methods/complexmatrix_inverse.morpho @@ -0,0 +1,12 @@ +// Inverse + +var A = ComplexMatrix(2,2) +A[0,0]=0+0im +A[0,1]=1+im +A[1,0]=1-im +A[1,1]=0+0im + +var Ainv = ComplexMatrix([[0, 0.5+0.5im],[0.5-0.5im, 0]]) + +print (A.inverse() - Ainv).norm() < 1e-10 // expect: true + diff --git a/test/linalg/methods/complexmatrix_inverse_singular.morpho b/test/linalg/methods/complexmatrix_inverse_singular.morpho new file mode 100644 index 000000000..49b34a86d --- /dev/null +++ b/test/linalg/methods/complexmatrix_inverse_singular.morpho @@ -0,0 +1,11 @@ +// Inverse of singular ComplexMatrix + +var A = ComplexMatrix(2,2) +A[0,0]=1+0im +A[0,1]=2+0im +A[1,0]=2+0im +A[1,1]=4+0im + +print A.inverse() +// expect error 'LnAlgMtrxSnglr' + diff --git a/test/linalg/methods/complexmatrix_norm.morpho b/test/linalg/methods/complexmatrix_norm.morpho new file mode 100644 index 000000000..097297291 --- /dev/null +++ b/test/linalg/methods/complexmatrix_norm.morpho @@ -0,0 +1,20 @@ +// Norm of a ComplexMatrix +import constants + +var A = ComplexMatrix(2,2) +A[0,0]=1+im +A[0,1]=2+im +A[1,0]=3-3im +A[1,1]=4-4im + +print abs(A.norm(1) - (4*sqrt(2) + sqrt(5))) < 1e-15 +// expect: true + +print abs(A.norm(Inf) - 7*sqrt(2)) < 1e-15 +// expect: true + +print abs(A.norm() - sqrt(57)) < 1e-15 +// expect: true + +print A.norm(5) +// expect error 'LnAlgMtrxNrmArgs' diff --git a/test/linalg/methods/complexmatrix_outer.morpho b/test/linalg/methods/complexmatrix_outer.morpho new file mode 100644 index 000000000..4a2e6ffb9 --- /dev/null +++ b/test/linalg/methods/complexmatrix_outer.morpho @@ -0,0 +1,9 @@ +// Outer product of two vectors + +var A = ComplexMatrix((1+1im,2-2im,3+3im)) +var B = ComplexMatrix((4+4im,5-5im)) + +print A.outer(B) +// expect: [ 0 + 8im 10 + 0im ] +// expect: [ 16 + 0im 0 - 20im ] +// expect: [ 0 + 24im 30 + 0im ] diff --git a/test/linalg/methods/complexmatrix_qr.morpho b/test/linalg/methods/complexmatrix_qr.morpho new file mode 100644 index 000000000..cb339317a --- /dev/null +++ b/test/linalg/methods/complexmatrix_qr.morpho @@ -0,0 +1,140 @@ +// QR Decomposition for ComplexMatrix + +// Test with a square complex matrix +var A = ComplexMatrix(((1.0+1.0im, 2.0+0.0im, 3.0-1.0im), + (4.0+2.0im, 5.0+1.0im, 6.0+0.0im), + (7.0+0.0im, 8.0-1.0im, 9.0+2.0im))) + +var qr = A.qr() + +print qr +// expect: (, ) + +var Q = qr[0] +var R = qr[1] + +print Q.dimensions() +// expect: (3, 3) + +print R.dimensions() +// expect: (3, 3) + +// Verify Q is unitary: Q^H * Q should be approximately I (conjugate transpose) +var QHQ = Q.conjTranspose() * Q +var I = ComplexMatrix(3,3) +for (var i = 0; i < 3; i = i + 1) { + I[i,i] = 1.0 + 0.0im +} + +print (QHQ - I).norm() < 1e-10 +// expect: true + +// Verify R is upper triangular (check lower triangle is zero) +var R_lower_norm = 0.0 +for (var i = 0; i < 3; i = i + 1) { + for (var j = 0; j < i; j = j + 1) { + var val = R[i,j] + R_lower_norm += val.abs() + } +} +print R_lower_norm < 1e-10 +// expect: true + +// Verify Q * R has the right structure +var QR = Q * R +print QR.dimensions() +// expect: (3, 3) + +// Test with a non-square matrix (tall matrix) +var B = ComplexMatrix(4,2) +B[0,0] = 1.0 + 1.0im +B[0,1] = 2.0 + 0.0im +B[1,0] = 3.0 - 1.0im +B[1,1] = 4.0 + 2.0im +B[2,0] = 5.0 + 0.0im +B[2,1] = 6.0 - 1.0im +B[3,0] = 7.0 + 1.0im +B[3,1] = 8.0 + 0.0im + +var qr2 = B.qr() +var Q2 = qr2[0] +var R2 = qr2[1] + +print Q2.dimensions() +// expect: (4, 4) + +print R2.dimensions() +// expect: (4, 2) + +// Verify Q2 is unitary +var Q2HQ2 = Q2.conjTranspose() * Q2 +var I4 = ComplexMatrix(4,4) +for (var i = 0; i < 4; i = i + 1) { + I4[i,i] = 1.0 + 0.0im +} +print (Q2HQ2 - I4).norm() < 1e-10 +// expect: true + +// Verify R2 is upper triangular +var R2_lower_norm = 0.0 +for (var i = 0; i < 4; i = i + 1) { + for (var j = 0; j < 2; j = j + 1) { + if (i > j) { + var val = R2[i,j] + R2_lower_norm = val.abs() + } + } +} +print R2_lower_norm < 1e-10 +// expect: true + +// Verify Q2 * R2 reconstruction +var Q2R2 = Q2 * R2 +print (Q2R2 - B).norm() < 1e-10 +// expect: true + +// Test with a wide matrix +var C = ComplexMatrix(2,4) +C[0,0] = 1.0 + 1.0im +C[0,1] = 2.0 + 0.0im +C[0,2] = 3.0 - 1.0im +C[0,3] = 4.0 + 2.0im +C[1,0] = 5.0 + 0.0im +C[1,1] = 6.0 - 1.0im +C[1,2] = 7.0 + 1.0im +C[1,3] = 8.0 + 0.0im + +var qr3 = C.qr() +var Q3 = qr3[0] +var R3 = qr3[1] + +print Q3.dimensions() +// expect: (2, 2) + +print R3.dimensions() +// expect: (2, 4) + +// Verify Q3 is unitary +var Q3HQ3 = Q3.conjTranspose() * Q3 +var I2 = ComplexMatrix(2,2) +for (var i = 0; i < 2; i = i + 1) { + I2[i,i] = 1.0 + 0.0im +} +print (Q3HQ3 - I2).norm() < 1e-10 +// expect: true + +// Test with real-valued complex matrix (should work like real matrix) +var D = ComplexMatrix(((1.0+0.0im, 0.0+0.0im), + (0.0+0.0im, 2.0+0.0im))) +var qr4 = D.qr() +var Q4 = qr4[0] +var R4 = qr4[1] + +// Verify Q4 is unitary +var Q4HQ4 = Q4.conjTranspose() * Q4 +var I2b = ComplexMatrix(2,2) +for (var i = 0; i < 2; i = i + 1) { + I2b[i,i] = 1.0 + 0.0im +} +print (Q4HQ4 - I2b).norm() < 1e-10 +// expect: true diff --git a/test/linalg/methods/complexmatrix_real.morpho b/test/linalg/methods/complexmatrix_real.morpho new file mode 100644 index 000000000..620f25033 --- /dev/null +++ b/test/linalg/methods/complexmatrix_real.morpho @@ -0,0 +1,11 @@ +// Real part of a ComplexMatrix + +var A = ComplexMatrix(2,2) +A[0,0]=1+4im +A[0,1]=2+3im +A[1,0]=3+2im +A[1,1]=4+1im + +print A.real() +// expect: [ 1 2 ] +// expect: [ 3 4 ] diff --git a/test/linalg/methods/complexmatrix_reshape.morpho b/test/linalg/methods/complexmatrix_reshape.morpho new file mode 100644 index 000000000..cf4ea7822 --- /dev/null +++ b/test/linalg/methods/complexmatrix_reshape.morpho @@ -0,0 +1,18 @@ +// Reshape ComplexMatrix + +var A = ComplexMatrix(2,2) +A[0,0]=1+1im +A[1,0]=2+2im +A[0,1]=3+3im +A[1,1]=4+4im +print A +// expect: [ 1 + 1im 3 + 3im ] +// expect: [ 2 + 2im 4 + 4im ] + +A.reshape(4,1) +print A +// expect: [ 1 + 1im ] +// expect: [ 2 + 2im ] +// expect: [ 3 + 3im ] +// expect: [ 4 + 4im ] + diff --git a/test/linalg/methods/complexmatrix_roll.morpho b/test/linalg/methods/complexmatrix_roll.morpho new file mode 100644 index 000000000..c8ecb6904 --- /dev/null +++ b/test/linalg/methods/complexmatrix_roll.morpho @@ -0,0 +1,50 @@ +// Roll contents of a matrix + +var A = ComplexMatrix(3,3) +var k=0 +for (i in 0...3) for (j in 0...3) { A[i,j] = Complex(k,k); k+=1 } + +print A +// expect: [ 0 + 0im 1 + 1im 2 + 2im ] +// expect: [ 3 + 3im 4 + 4im 5 + 5im ] +// expect: [ 6 + 6im 7 + 7im 8 + 8im ] + +print A.roll(1,1) +// expect: [ 2 + 2im 0 + 0im 1 + 1im ] +// expect: [ 5 + 5im 3 + 3im 4 + 4im ] +// expect: [ 8 + 8im 6 + 6im 7 + 7im ] + +print A.roll(2,1) +// expect: [ 1 + 1im 2 + 2im 0 + 0im ] +// expect: [ 4 + 4im 5 + 5im 3 + 3im ] +// expect: [ 7 + 7im 8 + 8im 6 + 6im ] + +print A.roll(3,1) +// expect: [ 0 + 0im 1 + 1im 2 + 2im ] +// expect: [ 3 + 3im 4 + 4im 5 + 5im ] +// expect: [ 6 + 6im 7 + 7im 8 + 8im ] + +print A.roll(4,1) +// expect: [ 2 + 2im 0 + 0im 1 + 1im ] +// expect: [ 5 + 5im 3 + 3im 4 + 4im ] +// expect: [ 8 + 8im 6 + 6im 7 + 7im ] + +print A.roll(-1,0) +// expect: [ 3 + 3im 4 + 4im 5 + 5im ] +// expect: [ 6 + 6im 7 + 7im 8 + 8im ] +// expect: [ 0 + 0im 1 + 1im 2 + 2im ] + +print A.roll(-2,0) +// expect: [ 6 + 6im 7 + 7im 8 + 8im ] +// expect: [ 0 + 0im 1 + 1im 2 + 2im ] +// expect: [ 3 + 3im 4 + 4im 5 + 5im ] + +print A.roll(-3,0) +// expect: [ 0 + 0im 1 + 1im 2 + 2im ] +// expect: [ 3 + 3im 4 + 4im 5 + 5im ] +// expect: [ 6 + 6im 7 + 7im 8 + 8im ] + +print A.roll(-4,0) +// expect: [ 3 + 3im 4 + 4im 5 + 5im ] +// expect: [ 6 + 6im 7 + 7im 8 + 8im ] +// expect: [ 0 + 0im 1 + 1im 2 + 2im ] diff --git a/test/linalg/methods/complexmatrix_roll_negative.morpho b/test/linalg/methods/complexmatrix_roll_negative.morpho new file mode 100644 index 000000000..ef2e2a81b --- /dev/null +++ b/test/linalg/methods/complexmatrix_roll_negative.morpho @@ -0,0 +1,12 @@ +// Negative roll values for ComplexMatrix + +var A = ComplexMatrix(3,1) +A[0,0]=1+1im +A[1,0]=2+2im +A[2,0]=3+3im + +print A.roll(-1) +// expect: [ 2 + 2im ] +// expect: [ 3 + 3im ] +// expect: [ 1 + 1im ] + diff --git a/test/linalg/methods/complexmatrix_sum.morpho b/test/linalg/methods/complexmatrix_sum.morpho new file mode 100644 index 000000000..64369ace2 --- /dev/null +++ b/test/linalg/methods/complexmatrix_sum.morpho @@ -0,0 +1,12 @@ +// Sum + +var A = ComplexMatrix(3,2) +A[0,0]=1+im +A[0,1]=2+2im +A[1,0]=3+3im +A[1,1]=4+4im +A[2,0]=5+5im +A[2,1]=6+6im + +print A.sum() +// expect: 21 + 21im diff --git a/test/linalg/methods/complexmatrix_svd.morpho b/test/linalg/methods/complexmatrix_svd.morpho new file mode 100644 index 000000000..388681fa1 --- /dev/null +++ b/test/linalg/methods/complexmatrix_svd.morpho @@ -0,0 +1,21 @@ +// Singular Value Decomposition + +var A = ComplexMatrix(((1+1im,0+0im),(0+0im,2+2im))) + +var svd = A.svd() + +// Test reconstruction: U * S * V^T should approximately equal A +var U = svd[0] +var S = svd[1] +var V = svd[2] + +// Create diagonal matrix from singular values +var Sdiag = ComplexMatrix(2,2) +Sdiag[0,0] = S[0] +Sdiag[1,1] = S[1] + +var VT = V.transpose() +var reconstructed = U * Sdiag * VT + +print (reconstructed - A).norm() < 1e-10 +// expect: true diff --git a/test/linalg/methods/complexmatrix_trace.morpho b/test/linalg/methods/complexmatrix_trace.morpho new file mode 100644 index 000000000..4a01913f6 --- /dev/null +++ b/test/linalg/methods/complexmatrix_trace.morpho @@ -0,0 +1,10 @@ +// Inverse + +var A = ComplexMatrix(2,2) +A[0,0]=1+4im +A[0,1]=2+3im +A[1,0]=3+2im +A[1,1]=4+1im + +print A.trace() +// expect: 5 + 5im diff --git a/test/linalg/methods/complexmatrix_transpose.morpho b/test/linalg/methods/complexmatrix_transpose.morpho new file mode 100644 index 000000000..920495853 --- /dev/null +++ b/test/linalg/methods/complexmatrix_transpose.morpho @@ -0,0 +1,13 @@ +// Inverse + +var A = ComplexMatrix(3,2) +A[0,0]=1+1im +A[0,1]=2+2im +A[1,0]=3+3im +A[1,1]=4+4im +A[2,0]=5+5im +A[2,1]=6+6im + +print A.transpose() +// expect: [ 1 + 1im 3 + 3im 5 + 5im ] +// expect: [ 2 + 2im 4 + 4im 6 + 6im ] diff --git a/test/linalg/methods/matrix_count.morpho b/test/linalg/methods/matrix_count.morpho new file mode 100644 index 000000000..46d5a971a --- /dev/null +++ b/test/linalg/methods/matrix_count.morpho @@ -0,0 +1,13 @@ +// Count elements in Matrix + +var A = Matrix(2,3) +A[0,0]=1 +A[0,1]=2 +A[0,2]=3 +A[1,0]=4 +A[1,1]=5 +A[1,2]=6 + +print A.count() +// expect: 6 + diff --git a/test/linalg/methods/matrix_dimensions.morpho b/test/linalg/methods/matrix_dimensions.morpho new file mode 100644 index 000000000..9fa7f8b53 --- /dev/null +++ b/test/linalg/methods/matrix_dimensions.morpho @@ -0,0 +1,9 @@ +// Get dimensions of Matrix + +var A = Matrix(2,3) +print A.dimensions() +// expect: (2, 3) + +var a = Matrix([[0.8, -0.4], [0.4, 0.8]]) +print a.dimensions() +// expect: (2, 2) diff --git a/test/linalg/methods/matrix_eigensystem.morpho b/test/linalg/methods/matrix_eigensystem.morpho new file mode 100644 index 000000000..957f676db --- /dev/null +++ b/test/linalg/methods/matrix_eigensystem.morpho @@ -0,0 +1,19 @@ +// Eigenvalues and eigenvectors + +var A = Matrix(2,2) +A[0,0]=0 +A[0,1]=1 +A[1,0]=1 +A[1,1]=0 + +var es=A.eigensystem() + +print es +// expect: ((1, -1), ) + +print es[0] +// expect: (1, -1) + +print es[1].format("%.2g") +// expect: [ 0.71 -0.71 ] +// expect: [ 0.71 0.71 ] diff --git a/test/linalg/methods/matrix_eigenvalues.morpho b/test/linalg/methods/matrix_eigenvalues.morpho new file mode 100644 index 000000000..e45399ebd --- /dev/null +++ b/test/linalg/methods/matrix_eigenvalues.morpho @@ -0,0 +1,10 @@ +// Eigenvalues + +var A = Matrix(2,2) +A[0,0]=0 +A[0,1]=1 +A[1,0]=1 +A[1,1]=0 + +print A.eigenvalues() +// expect: (1, -1) diff --git a/test/linalg/methods/matrix_enumerate.morpho b/test/linalg/methods/matrix_enumerate.morpho new file mode 100644 index 000000000..37d1cafa1 --- /dev/null +++ b/test/linalg/methods/matrix_enumerate.morpho @@ -0,0 +1,13 @@ +// Enumerate elements of a matrix + +var A = Matrix(2,2) +A[0,0] = 1 +A[1,0] = 2 +A[0,1] = 3 +A[1,1] = 4 + +for (x in A) print x +// expect: 1 +// expect: 2 +// expect: 3 +// expect: 4 diff --git a/test/linalg/methods/matrix_format.morpho b/test/linalg/methods/matrix_format.morpho new file mode 100644 index 000000000..999c831ed --- /dev/null +++ b/test/linalg/methods/matrix_format.morpho @@ -0,0 +1,12 @@ +// Format +import constants + +var A = Matrix(2,2) +A[0,0]=1 +A[0,1]=Pi/2 +A[1,0]=Pi/2 +A[1,1]=-1.5 + +print A.format("%5.2f") +// expect: [ 1.00 1.57 ] +// expect: [ 1.57 -1.50 ] diff --git a/test/linalg/methods/matrix_inner.morpho b/test/linalg/methods/matrix_inner.morpho new file mode 100644 index 000000000..4c789d22f --- /dev/null +++ b/test/linalg/methods/matrix_inner.morpho @@ -0,0 +1,17 @@ +// Inner product of Matrices + +var A = Matrix(2,2) +A[0,0]=1 +A[0,1]=2 +A[1,0]=3 +A[1,1]=4 + +var B = Matrix(2,2) +B[0,0]=1 +B[0,1]=0 +B[1,0]=0 +B[1,1]=1 + +print A.inner(B) +// expect: 5 + diff --git a/test/linalg/methods/matrix_inverse.morpho b/test/linalg/methods/matrix_inverse.morpho new file mode 100644 index 000000000..85b4e02a4 --- /dev/null +++ b/test/linalg/methods/matrix_inverse.morpho @@ -0,0 +1,11 @@ +// Inverse + +var A = Matrix(2,2) +A[0,0]=1 +A[0,1]=2 +A[1,0]=3 +A[1,1]=4 + +print A.inverse() +// expect: [ -2 1 ] +// expect: [ 1.5 -0.5 ] diff --git a/test/linalg/methods/matrix_inverse_singular.morpho b/test/linalg/methods/matrix_inverse_singular.morpho new file mode 100644 index 000000000..d3dea86ac --- /dev/null +++ b/test/linalg/methods/matrix_inverse_singular.morpho @@ -0,0 +1,10 @@ +// Inverse + +var A = Matrix(2,2) +A[0,0]=1 +A[0,1]=2 +A[1,0]=2 +A[1,1]=4 + +print A.inverse() +// expect error 'LnAlgMtrxSnglr' diff --git a/test/linalg/methods/matrix_norm.morpho b/test/linalg/methods/matrix_norm.morpho new file mode 100644 index 000000000..b1a4cd67e --- /dev/null +++ b/test/linalg/methods/matrix_norm.morpho @@ -0,0 +1,20 @@ +// Norm of an Matrix +import constants + +var A = Matrix(2,2) +A[0,0]=1 +A[0,1]=-2 +A[1,0]=3 +A[1,1]=-4 + +print A.norm(1) +// expect: 6 + +print A.norm(Inf) +// expect: 7 + +print abs(A.norm() - sqrt(30)) < 1e-15 +// expect: true + +print A.norm(5) +// expect error 'LnAlgMtrxNrmArgs' diff --git a/test/linalg/methods/matrix_outer.morpho b/test/linalg/methods/matrix_outer.morpho new file mode 100644 index 000000000..bb08c58c4 --- /dev/null +++ b/test/linalg/methods/matrix_outer.morpho @@ -0,0 +1,9 @@ +// Outer product of two vectors + +var A = Matrix((1,2,3)) +var B = Matrix((4,5)) + +print A.outer(B) +// expect: [ 4 5 ] +// expect: [ 8 10 ] +// expect: [ 12 15 ] diff --git a/test/linalg/methods/matrix_qr.morpho b/test/linalg/methods/matrix_qr.morpho new file mode 100644 index 000000000..60125e5cc --- /dev/null +++ b/test/linalg/methods/matrix_qr.morpho @@ -0,0 +1,130 @@ +// QR Decomposition + +// Test with a square matrix (this one is singular, so R will have a zero on the diagonal) +var A = Matrix(((1.0,2.0,3.0),(4.0,5.0,6.0),(7.0,8.0,9.0))) + +var qr = A.qr() + +print qr +// expect: (, ) + +var Q = qr[0] +var R = qr[1] + +print Q.dimensions() +// expect: (3, 3) + +print R.dimensions() +// expect: (3, 3) + +// Verify Q is orthogonal: Q^T * Q should be approximately I +var QTQ = Q.transpose() * Q +var I = IdentityMatrix(3) + +print (QTQ - I).norm() < 1e-10 +// expect: true + +// Verify R is upper triangular (check lower triangle is zero) +var R_lower_norm = 0.0 +for (var i = 0; i < 3; i = i + 1) { + for (var j = 0; j < i; j = j + 1) { + R_lower_norm = R_lower_norm + R[i,j]*R[i,j] + } +} +print R_lower_norm < 1e-10 +// expect: true + +// Check R's diagonal - since A is singular, one diagonal element should be (close to) zero +// This indicates the matrix has rank 2 (not full rank) +print abs(R[2,2]) < 1e-8 +// expect: true + +// Verify Q * R reconstruction +var QR = Q * R +print (QR - A).norm() < 1e-10 +// expect: true + +// Test with a non-square matrix (tall matrix) +var B = Matrix(4,2) +B[0,0] = 1.0 +B[0,1] = 2.0 +B[1,0] = 3.0 +B[1,1] = 4.0 +B[2,0] = 5.0 +B[2,1] = 6.0 +B[3,0] = 7.0 +B[3,1] = 8.0 + +var qr2 = B.qr() +var Q2 = qr2[0] +var R2 = qr2[1] + +print Q2.dimensions() +// expect: (4, 4) + +print R2.dimensions() +// expect: (4, 2) + +// Verify Q2 is orthogonal +var Q2TQ2 = Q2.transpose() * Q2 +var I4 = IdentityMatrix(4) +print (Q2TQ2 - I4).norm() < 1e-10 +// expect: true + +// Verify R2 is upper triangular +var R2_lower_norm = 0.0 +for (var i = 0; i < 4; i = i + 1) { + for (var j = 0; j < 2; j = j + 1) { + if (i > j) { + R2_lower_norm = R2_lower_norm + R2[i,j]*R2[i,j] + } + } +} +print R2_lower_norm < 1e-10 +// expect: true + +// Verify Q2 * R2 reconstruction +var Q2R2 = Q2 * R2 +print (Q2R2 - B).norm() < 1e-10 +// expect: true + +// Test with a wide matrix +var C = Matrix(2,4) +C[0,0] = 1.0 +C[0,1] = 2.0 +C[0,2] = 3.0 +C[0,3] = 4.0 +C[1,0] = 5.0 +C[1,1] = 6.0 +C[1,2] = 7.0 +C[1,3] = 8.0 + +var qr3 = C.qr() +var Q3 = qr3[0] +var R3 = qr3[1] + +print Q3.dimensions() +// expect: (2, 2) + +print R3.dimensions() +// expect: (2, 4) + +// Verify Q3 is orthogonal +var Q3TQ3 = Q3.transpose() * Q3 +var I2 = IdentityMatrix(2) +print (Q3TQ3 - I2).norm() < 1e-10 +// expect: true + +// Test with identity matrix +var I3 = IdentityMatrix(3) +var qr4 = I3.qr() +var Q4 = qr4[0] +var R4 = qr4[1] + +// Q should be close to identity +print (Q4 - I3).norm() < 1e-10 +// expect: true + +// R should be close to identity +print (R4 - I3).norm() < 1e-10 +// expect: true diff --git a/test/linalg/methods/matrix_reshape.morpho b/test/linalg/methods/matrix_reshape.morpho new file mode 100644 index 000000000..d49bbe5bf --- /dev/null +++ b/test/linalg/methods/matrix_reshape.morpho @@ -0,0 +1,18 @@ +// Reshape Matrix + +var A = Matrix(2,2) +A[0,0]=1 +A[1,0]=2 +A[0,1]=3 +A[1,1]=4 +print A +// expect: [ 1 3 ] +// expect: [ 2 4 ] + +A.reshape(4,1) +print A +// expect: [ 1 ] +// expect: [ 2 ] +// expect: [ 3 ] +// expect: [ 4 ] + diff --git a/test/linalg/methods/matrix_roll.morpho b/test/linalg/methods/matrix_roll.morpho new file mode 100644 index 000000000..b0a74648f --- /dev/null +++ b/test/linalg/methods/matrix_roll.morpho @@ -0,0 +1,50 @@ +// Roll contents of a matrix + +var A = Matrix(3,3) +var k=0 +for (i in 0...3) for (j in 0...3) { A[i,j] = k; k+=1 } + +print A +// expect: [ 0 1 2 ] +// expect: [ 3 4 5 ] +// expect: [ 6 7 8 ] + +print A.roll(1,1) +// expect: [ 2 0 1 ] +// expect: [ 5 3 4 ] +// expect: [ 8 6 7 ] + +print A.roll(2,1) +// expect: [ 1 2 0 ] +// expect: [ 4 5 3 ] +// expect: [ 7 8 6 ] + +print A.roll(3,1) +// expect: [ 0 1 2 ] +// expect: [ 3 4 5 ] +// expect: [ 6 7 8 ] + +print A.roll(4,1) +// expect: [ 2 0 1 ] +// expect: [ 5 3 4 ] +// expect: [ 8 6 7 ] + +print A.roll(-1,0) +// expect: [ 3 4 5 ] +// expect: [ 6 7 8 ] +// expect: [ 0 1 2 ] + +print A.roll(-2,0) +// expect: [ 6 7 8 ] +// expect: [ 0 1 2 ] +// expect: [ 3 4 5 ] + +print A.roll(-3,0) +// expect: [ 0 1 2 ] +// expect: [ 3 4 5 ] +// expect: [ 6 7 8 ] + +print A.roll(-4,0) +// expect: [ 3 4 5 ] +// expect: [ 6 7 8 ] +// expect: [ 0 1 2 ] diff --git a/test/linalg/methods/matrix_sum.morpho b/test/linalg/methods/matrix_sum.morpho new file mode 100644 index 000000000..0ccdee3b3 --- /dev/null +++ b/test/linalg/methods/matrix_sum.morpho @@ -0,0 +1,12 @@ +// Sum + +var A = Matrix(3,2) +A[0,0]=1 +A[0,1]=2 +A[1,0]=3 +A[1,1]=4 +A[2,0]=5 +A[2,1]=6 + +print A.sum() +// expect: 21 diff --git a/test/linalg/methods/matrix_svd.morpho b/test/linalg/methods/matrix_svd.morpho new file mode 100644 index 000000000..23cdac478 --- /dev/null +++ b/test/linalg/methods/matrix_svd.morpho @@ -0,0 +1,53 @@ +// Singular Value Decomposition + +var A = Matrix(((1,0),(0,2))) + +var svd = A.svd() + +print svd +// expect: (, (2, 1), ) + +print (svd[0] - Matrix(((0,1),(1,0)))).norm() < 1e-10 +// expect: true + +print svd[1] +// expect: (2, 1) + +print (svd[2] - Matrix(((0,1),(1,0)))).norm() < 1e-10 +// expect: true + +// Test reconstruction: U * S * V^T should approximately equal A +var U = svd[0] +var S = svd[1] +var V = svd[2] + +// Create diagonal matrix from singular values +var Sdiag = Matrix(2,2) +Sdiag[0,0] = S[0] +Sdiag[1,1] = S[1] + +var VT = V.transpose() +var reconstructed = U * Sdiag * VT + +print (reconstructed - A).norm() < 1e-10 +// expect: true + +// Test with a non-square matrix +var B = Matrix(3,2) +B[0,0]=1 +B[0,1]=0 +B[1,0]=0 +B[1,1]=2 +B[2,0]=0 +B[2,1]=0 + +var svd2 = B.svd() + +print svd2[0].dimensions() +// expect: (3, 3) + +print svd2[1] +// expect: (2, 1) + +print svd2[2].dimensions() +// expect: (2, 2) diff --git a/test/linalg/methods/matrix_trace.morpho b/test/linalg/methods/matrix_trace.morpho new file mode 100644 index 000000000..2fe81a5f7 --- /dev/null +++ b/test/linalg/methods/matrix_trace.morpho @@ -0,0 +1,10 @@ +// Inverse + +var A = Matrix(2,2) +A[0,0]=1 +A[0,1]=2 +A[1,0]=3 +A[1,1]=4 + +print A.trace() +// expect: 5 diff --git a/test/linalg/methods/matrix_transpose.morpho b/test/linalg/methods/matrix_transpose.morpho new file mode 100644 index 000000000..4043881e8 --- /dev/null +++ b/test/linalg/methods/matrix_transpose.morpho @@ -0,0 +1,13 @@ +// Inverse + +var A = Matrix(3,2) +A[0,0]=1 +A[0,1]=2 +A[1,0]=3 +A[1,1]=4 +A[2,0]=5 +A[2,1]=6 + +print A.transpose() +// expect: [ 1 3 5 ] +// expect: [ 2 4 6 ] diff --git a/test/list/order.morpho b/test/list/order.morpho index 34fdb138a..2ee5041fb 100644 --- a/test/list/order.morpho +++ b/test/list/order.morpho @@ -6,7 +6,7 @@ var lst = [ 3,2,1 ] print lst // expect: [ 3, 2, 1 ] print lst.order() -// expect: [ 2, 1, 0 ] +// expect: (2, 1, 0) print lst.sort() // // expect: nil print lst @@ -19,7 +19,7 @@ print a // expect: [ 1, 0.92388, 0.707107, 0.382683, 6.12323e-17, -0.382683, -0.707107, -0.92388, -1, -0.92388, -0.707107, -0.382683, -1.83697e-16, 0.382683, 0.707107, 0.92388, 1 ] var o = a.order() print o -// expect: [ 8, 9, 7, 10, 6, 11, 5, 12, 4, 3, 13, 2, 14, 1, 15, 0, 16 ] +// expect: (8, 9, 7, 10, 6, 11, 5, 12, 4, 3, 13, 2, 14, 1, 15, 0, 16) var y = [] for (i in 0...a.count()) y.append(a[o[i]]) diff --git a/test/matrix/Lnorm.morpho b/test/matrix/Lnorm.morpho index e3fb763bd..ac6e70948 100644 --- a/test/matrix/Lnorm.morpho +++ b/test/matrix/Lnorm.morpho @@ -5,9 +5,5 @@ var a = Matrix([1,2,3]) print a.norm(1) // expect: 6 -print abs(a.norm(2) - 3.74166) < 1e-4 // expect: true - -print abs(a.norm(3) - 3.30193) < 1e-4 // expect: true - print a.norm(Inf) // expect: 3 diff --git a/test/matrix/assign.morpho b/test/matrix/assign.morpho index 68aa43f97..c18d55f55 100644 --- a/test/matrix/assign.morpho +++ b/test/matrix/assign.morpho @@ -14,4 +14,4 @@ print b var c = Matrix(1,2) b.assign(c) -// expect error 'MtrxIncmptbl' +// expect error 'LnAlgMtrxIncmptbl' diff --git a/test/matrix/blockmatrix_constructor.morpho b/test/matrix/blockmatrix_constructor.morpho index ea012bc03..e5a45cb3c 100644 --- a/test/matrix/blockmatrix_constructor.morpho +++ b/test/matrix/blockmatrix_constructor.morpho @@ -1,4 +1,4 @@ // Block matrix constructor with single list print Matrix([Matrix(2)]) -// expect error 'MtrxInvldInit' +// expect error 'LnAlgMtrxInvldArg' diff --git a/test/matrix/concatenate.morpho b/test/matrix/concatenate.morpho index ba00ec794..c88f253a7 100644 --- a/test/matrix/concatenate.morpho +++ b/test/matrix/concatenate.morpho @@ -28,4 +28,4 @@ print c // expect: [ 2 3 2 3 0 ] var c = Matrix([[a, b], [b, 0]]) -// expect error 'MtrxIncmptbl' +// expect error 'LnAlgMtrxIncmptbl' diff --git a/test/matrix/concatenate_sparse.morpho b/test/matrix/concatenate_sparse.morpho index 100d01366..66fb4f6ec 100644 --- a/test/matrix/concatenate_sparse.morpho +++ b/test/matrix/concatenate_sparse.morpho @@ -24,4 +24,4 @@ print c // expect: [ 2 3 2 3 0 ] var c = Matrix([[a, b], [b, 0]]) -// expect error 'MtrxIncmptbl' +// expect error 'LnAlgMtrxIncmptbl' diff --git a/test/matrix/dimensions.morpho b/test/matrix/dimensions.morpho index 2ef712128..2fe92517e 100644 --- a/test/matrix/dimensions.morpho +++ b/test/matrix/dimensions.morpho @@ -4,7 +4,7 @@ var a = Matrix([[0.8, -0.4], [0.4, 0.8]]) var v = Matrix([0.2, 0.3]) print a.dimensions() -// expect: [ 2, 2 ] +// expect: (2, 2) print v.dimensions() -// expect: [ 2, 1 ] +// expect: (2, 1) diff --git a/test/matrix/eigensystem.morpho b/test/matrix/eigensystem.morpho index 17e1e55b7..351eece30 100644 --- a/test/matrix/eigensystem.morpho +++ b/test/matrix/eigensystem.morpho @@ -4,5 +4,6 @@ var a = Matrix([[ -0.083929, 0.102945, 0.213477 ], [ 0.102945, -0.108697, 0.189335 ], [ 0.213477, 0.189335, 0.192626 ]]) -print a.eigensystem() -// expect: [ , ] \ No newline at end of file +var b = a.eigensystem() +print b[0].clss() // expect: @Tuple +print b[1].clss() // expect: @Matrix diff --git a/test/matrix/eigenvalues.morpho b/test/matrix/eigenvalues.morpho index 562f3d62d..b874b4072 100644 --- a/test/matrix/eigenvalues.morpho +++ b/test/matrix/eigenvalues.morpho @@ -3,9 +3,8 @@ var a = Matrix([[1,-1,0], [-1,1,0], [0,0,1]]) var ev = a.eigenvalues() -ev.sort() -print ev -// expect: [ 0, 1, 2 ] +print ev.sort() +// expect: (0, 1, 2) var b = Matrix([[1,2,0], [-2,1,0], [0,0,1]]) @@ -22,7 +21,7 @@ print a // ensure a is not overwritten var es = a.eigensystem() print es[0] -// expect: [ 2, 0, 1 ] +// expect: (2, 0, 1) print es[1] // expect: [ 0.707107 0.707107 0 ] // expect: [ -0.707107 0.707107 0 ] diff --git a/test/matrix/get_column.morpho b/test/matrix/get_column.morpho index 94ba03145..d8d666210 100644 --- a/test/matrix/get_column.morpho +++ b/test/matrix/get_column.morpho @@ -17,4 +17,4 @@ print a.column(2) // expect: [ 12 ] print a.column(10) -// expect Error 'MtrxBnds' +// expect Error 'LnAlgMtrxIndxBnds' diff --git a/test/matrix/identity.morpho b/test/matrix/identity.morpho index ba47e170c..be369c82f 100644 --- a/test/matrix/identity.morpho +++ b/test/matrix/identity.morpho @@ -12,4 +12,4 @@ print a // expect: [ 0 0 1 ] a = IdentityMatrix() -// expect error 'MtrxIdnttyCns' +// expect error 'MltplDsptchFld' diff --git a/test/matrix/incompatible_add.morpho b/test/matrix/incompatible_add.morpho index 0045a01ea..650250b31 100644 --- a/test/matrix/incompatible_add.morpho +++ b/test/matrix/incompatible_add.morpho @@ -4,4 +4,4 @@ var a = Matrix([[1, 2, 1], [3, 4, 1]]) var b = Matrix([[0, 1], [1, 0]]) print a+b -// expect Error: 'MtrxIncmptbl' +// expect Error: 'LnAlgMtrxIncmptbl' diff --git a/test/matrix/incompatible_mul.morpho b/test/matrix/incompatible_mul.morpho index 769698df1..dc681121b 100644 --- a/test/matrix/incompatible_mul.morpho +++ b/test/matrix/incompatible_mul.morpho @@ -4,4 +4,4 @@ var a = Matrix([[1, 2, 1], [3, 4, 1]]) var b = Matrix([[0, 1], [1, 0]]) print a*b -// expect Error: 'MtrxIncmptbl' +// expect Error: 'LnAlgMtrxIncmptbl' diff --git a/test/matrix/incompatible_sub.morpho b/test/matrix/incompatible_sub.morpho index d056a9614..751af5d67 100644 --- a/test/matrix/incompatible_sub.morpho +++ b/test/matrix/incompatible_sub.morpho @@ -4,4 +4,4 @@ var a = Matrix([[1, 2, 1], [3, 4, 1]]) var b = Matrix([[0, 1], [1, 0]]) print a*b -// expect Error: 'MtrxIncmptbl' +// expect Error: 'LnAlgMtrxIncmptbl' diff --git a/test/matrix/initializer.morpho b/test/matrix/initializer.morpho index 5d24e1d8d..846ad9a66 100644 --- a/test/matrix/initializer.morpho +++ b/test/matrix/initializer.morpho @@ -33,5 +33,5 @@ print w // expect: [ 3 4 ] var w = Matrix([[1,[2,3]]]) -// expect Error 'MtrxInvldInit' +// expect Error 'LnAlgMtrxInvldArg' print w diff --git a/test/matrix/inverse.morpho b/test/matrix/inverse.morpho index 628acad30..de8879e16 100644 --- a/test/matrix/inverse.morpho +++ b/test/matrix/inverse.morpho @@ -15,4 +15,4 @@ print ((mi[1,1] - a/det)<1e-8) // expect: true var m = Matrix([[1,0,0],[0,1,0],[0,0,0]]) -print m.inverse() // expect error 'MtrxSnglr' +print m.inverse() // expect error 'LnAlgMtrxSnglr' diff --git a/test/matrix/linearsolve.morpho b/test/matrix/linearsolve.morpho index f22e45d09..4f27656c0 100644 --- a/test/matrix/linearsolve.morpho +++ b/test/matrix/linearsolve.morpho @@ -21,4 +21,4 @@ print a var b = Matrix([[3, 4], [6, 8]]) print v/b -// expect error 'MtrxSnglr' +// expect error 'LnAlgMtrxSnglr' diff --git a/test/matrix/nonnum_indices.morpho b/test/matrix/nonnum_indices.morpho index 4ef542786..7f1b7d10a 100644 --- a/test/matrix/nonnum_indices.morpho +++ b/test/matrix/nonnum_indices.morpho @@ -3,4 +3,4 @@ var a = Matrix([[1,2], [3,4], [5,6]]) print a["Hello", "Squirrel"] -// expect error: 'MtrxInvldIndx' +// expect error: 'LnAlgMtrxNnNmrclArg' diff --git a/test/matrix/nonnum_initializer.morpho b/test/matrix/nonnum_initializer.morpho index 68fd001b3..b94e4f486 100644 --- a/test/matrix/nonnum_initializer.morpho +++ b/test/matrix/nonnum_initializer.morpho @@ -1,4 +1,4 @@ // Non numerical initializer var m = Matrix([[1,2], [3,"oops"]]) -// expect error: 'MtrxInvldInit' +// expect error: 'LnAlgMtrxInvldArg' diff --git a/test/matrix/reshape.morpho b/test/matrix/reshape.morpho index 12adcf5ee..e3470ce7c 100644 --- a/test/matrix/reshape.morpho +++ b/test/matrix/reshape.morpho @@ -31,4 +31,4 @@ print a // expect: [ 3 6 ] a.reshape(3,3) -// expect error 'MtrxIncmptbl' +// expect error 'LnAlgMtrxIncmptbl' diff --git a/test/matrix/trace.morpho b/test/matrix/trace.morpho index cca52b46e..481654129 100644 --- a/test/matrix/trace.morpho +++ b/test/matrix/trace.morpho @@ -7,4 +7,4 @@ print a.trace() var b = Matrix([[1, 2]]) print b.trace() -// expect error 'MtrxNtSq' +// expect error 'LnAlgMtrxNtSq' diff --git a/test/mesh/barycentric.morpho b/test/mesh/barycentric.morpho new file mode 100644 index 000000000..73cbef857 --- /dev/null +++ b/test/mesh/barycentric.morpho @@ -0,0 +1,16 @@ +var a = Mesh("square.mesh") + +print a.barycentric(2, 0, Matrix([0, 0, 0])) +// expect: [ 1 ] +// expect: [ 0 ] +// expect: [ 0 ] + +print a.barycentric(2, 0, Matrix([0.25, 0.25, 0])) +// expect: [ 0.5 ] +// expect: [ 0.25 ] +// expect: [ 0.25 ] + +print a.barycentric(2, 1, Matrix([0.75, 0.75, 0])) +// expect: [ 0.25 ] +// expect: [ 0.25 ] +// expect: [ 0.5 ] diff --git a/test/modules/meshtools/debug_elementdofs_3d.morpho b/test/modules/meshtools/debug_elementdofs_3d.morpho new file mode 100644 index 000000000..b76e2efbc --- /dev/null +++ b/test/modules/meshtools/debug_elementdofs_3d.morpho @@ -0,0 +1,82 @@ +import meshtools + +fn buildmesh() { + var mb = MeshBuilder() + mb.addvertex([0,0,0]) + mb.addvertex([1,0,0]) + mb.addvertex([0,1,0]) + mb.addvertex([0,0,1]) + mb.addvolume([0,1,2,3]) + var m = mb.build() + m.addgrade(1) + m.addgrade(2) + m.addgrade(3) + return m +} + +fn allcellsok(field, ndofs) { + var mesh = field.mesh() + for (cid in 0...mesh.count(3)) { + var dofs = field.elementDofs(cid) + if (!islist(dofs) || dofs.count()!=ndofs) { + print "bad cell ${cid}: ${dofs}" + return false + } + } + + return true +} + +var m = buildmesh() +var cg2 = FiniteElementSpace("CG2", grade=3) +var coarse2 = Field(m, 0, finiteelementspace=cg2) +var dofs2 = coarse2.elementDofs(0) + +print islist(dofs2) +// expect: true +print dofs2.count()==10 +// expect: true + +var refmap2 = MeshRefiner(m).refine() +var newm2 = refmap2[m] +var refined2 = Field(newm2, 0, finiteelementspace=cg2) + +print newm2.count(0)==10 +// expect: true +print newm2.count(1)==25 +// expect: true +print newm2.count(2)==24 +// expect: true +print newm2.count(3)==8 +// expect: true +print [newm2.count(0), newm2.count(1), newm2.count(2), newm2.count(3)] +// expect: [ 10, 25, 24, 8 ] +print allcellsok(refined2, 10) +// expect: true + +var m3 = buildmesh() +var cg3 = FiniteElementSpace("CG3", grade=3) +var coarse3 = Field(m3, 0, finiteelementspace=cg3) +var dofs3 = coarse3.elementDofs(0) + +print islist(dofs3) +// expect: true +print dofs3.count()==20 +// expect: true + +var refmap3 = MeshRefiner(m3).refine() +var newm3 = refmap3[m3] +var refined3 = Field(newm3, 0, finiteelementspace=cg3) + +print newm3.count(0)==10 +// expect: true +print newm3.count(1)==25 +// expect: true +print newm3.count(2)==24 +// expect: true +print newm3.count(3)==8 +// expect: true +print [newm3.count(0), newm3.count(1), newm3.count(2), newm3.count(3)] +// expect: [ 10, 25, 24, 8 ] +print allcellsok(refined3, 20) +// expect: true diff --git a/test/modules/meshtools/meshchecker.morpho b/test/modules/meshtools/meshchecker.morpho new file mode 100644 index 000000000..86b1a5203 --- /dev/null +++ b/test/modules/meshtools/meshchecker.morpho @@ -0,0 +1,38 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvolume([0,1,2,3]) + +var m = mb.build() +m.addgrade(1) +m.addgrade(2) +m.addgrade(3) + +var checker = MeshChecker(m, quiet=true) + +checker.countElements() +// expect: Grade 0: 4 elements +// expect: Grade 1: 6 elements +// expect: Grade 2: 4 elements +// expect: Grade 3: 1 elements + +var sizes = checker.checkElementSize() +print sizes[1].count()==0 +// expect: true +print sizes[2].count()==0 +// expect: true +print sizes[3].count()==0 +// expect: true + +checker.checkElementDim() +checker.checkDuplicateVertices() +checker.checkDuplicateElements() +checker.checkElementConnectivity() +checker.check() + +print true +// expect: true diff --git a/test/modules/meshtools/refine1d_topology.morpho b/test/modules/meshtools/refine1d_topology.morpho new file mode 100644 index 000000000..835e97706 --- /dev/null +++ b/test/modules/meshtools/refine1d_topology.morpho @@ -0,0 +1,20 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0]) +mb.addvertex([1]) +mb.addedge([0,1]) +var m = mb.build() +m.addgrade(1) + +var mr = MeshRefiner(m) +var refmap = mr.refine() +var newm = refmap[m] + +print newm.count(0)==3 +// expect: true +print newm.count(1)==2 +// expect: true +print [newm.count(0), newm.count(1)] +// expect: [ 3, 2 ] + diff --git a/test/modules/meshtools/refine2d_topology.morpho b/test/modules/meshtools/refine2d_topology.morpho new file mode 100644 index 000000000..6e4d8136e --- /dev/null +++ b/test/modules/meshtools/refine2d_topology.morpho @@ -0,0 +1,33 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addface([0,1,2]) +var m = mb.build() +m.addgrade(1) +m.addgrade(2) + +var mr = MeshRefiner(m) +var refmap = mr.refine() +var newm = refmap[m] + +print newm.count(0)==6 +// expect: true +print newm.count(1)==9 +// expect: true +print newm.count(2)==4 +// expect: true +print [newm.count(0), newm.count(1), newm.count(2)] +// expect: [ 6, 9, 4 ] + +var faceconn = newm.connectivitymatrix(0, 2) +var alltriangles = true +for (fid in 0...newm.count(2)) { + if (faceconn.rowindices(fid).count()!=3) alltriangles = false +} + +print alltriangles +// expect: true + diff --git a/test/modules/meshtools/refine3d_topology.morpho b/test/modules/meshtools/refine3d_topology.morpho new file mode 100644 index 000000000..9b8725f32 --- /dev/null +++ b/test/modules/meshtools/refine3d_topology.morpho @@ -0,0 +1,45 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvolume([0,1,2,3]) +var m = mb.build() +m.addgrade(1) +m.addgrade(2) +m.addgrade(3) + +var mr = MeshRefiner(m) +var refmap = mr.refine() +var newm = refmap[m] + +print newm.count(0)==10 +// expect: true +print newm.count(1)==25 +// expect: true +print newm.count(2)==24 +// expect: true +print newm.count(3)==8 +// expect: true + +print [newm.count(0), newm.count(1), newm.count(2), newm.count(3)] +// expect: [ 10, 25, 24, 8 ] + +var edgeconn = newm.connectivitymatrix(0, 1) +var faceconn = newm.connectivitymatrix(0, 2) +var volconn = newm.connectivitymatrix(0, 3) + +var alledges = true +var allfaces = true + +for (cid in 0...newm.count(3)) { + if (volconn.rowindices(cid).sets(2).count()!=6) alledges = false + if (volconn.rowindices(cid).sets(3).count()!=4) allfaces = false +} + +print alledges +// expect: true +print allfaces +// expect: true diff --git a/test/modules/meshtools/refine3d_topology_2tets.morpho b/test/modules/meshtools/refine3d_topology_2tets.morpho new file mode 100644 index 000000000..51e96eed0 --- /dev/null +++ b/test/modules/meshtools/refine3d_topology_2tets.morpho @@ -0,0 +1,40 @@ +import meshtools + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvertex([0,0,-1]) +mb.addvolume([0,1,2,3]) +mb.addvolume([0,1,2,4]) +var m = mb.build() +m.addgrade(1) +m.addgrade(2) +m.addgrade(3) + +var mr = MeshRefiner(m) +var refmap = mr.refine() +var newm = refmap[m] + +print newm.count(0)==14 +// expect: true +print newm.count(1)==41 +// expect: true +print newm.count(2)==44 +// expect: true +print newm.count(3)==16 +// expect: true +print [newm.count(0), newm.count(1), newm.count(2), newm.count(3)] +// expect: [ 14, 41, 44, 16 ] + +var volconn = newm.connectivitymatrix(0, 3) +var allcells = true +for (cid in 0...newm.count(3)) { + var tet = volconn.rowindices(cid) + if (tet.sets(2).count()!=6) allcells = false + if (tet.sets(3).count()!=4) allcells = false +} + +print allcells +// expect: true diff --git a/test/modules/meshtools/refinecg2.morpho b/test/modules/meshtools/refinecg2.morpho new file mode 100644 index 000000000..f0a353d36 --- /dev/null +++ b/test/modules/meshtools/refinecg2.morpho @@ -0,0 +1,62 @@ +import meshtools + +fn point(lambda, vids, verts) { + var x = lambda[0]*verts.column(vids[0]) + for (j in 1...lambda.count()) x += lambda[j]*verts.column(vids[j]) + return x +} + +fn exact(x) { + return x[0]^3 - 0.5*x[0]*x[1] + 2*x[1]^2 +} + +fn preservesfield(field, oldfield, oldmesh) { + var mesh = field.mesh() + var fespace = field.finiteElementSpace() + var verts = mesh.vertexmatrix() + var faces = mesh.connectivitymatrix(0, 2) + var nodes = fespace.nodeCoords() + + for (fid in 0...mesh.count(2)) { + var vids = faces.rowindices(fid) + for (i in 0...fespace.count()) { + var lambda = nodes.column(i) + var x = point(lambda, vids, verts) + var oldlambda = oldmesh.barycentric(fespace.grade(), 0, x) + var expected = oldfield.evalElement(0, oldlambda) + var val = field.evalElement(fid, lambda) + if (abs(val-expected)>1e-10) return false + } + } + + return true +} + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addface([0,1,2]) +var m = mb.build() +m.addgrade(1) + +var fespace = FiniteElementSpace("CG2", grade=2) +var f = Field(m, fn (x,y) exact([x,y]), finiteelementspace=fespace) +var oldm = m +var oldf = f +var mr = MeshRefiner([m, f]) +var refmap = mr.refine() + +m = refmap[m] +f = refmap[f] + +print m.count(0)==6 +// expect: true +print m.count(1)==9 +// expect: true +print m.count(2)==4 +// expect: true +print f.shape()[0]==1 && f.shape()[1]==1 && f.shape()[2]==0 +// expect: true +print preservesfield(f, oldf, oldm) +// expect: true diff --git a/test/modules/meshtools/refinecg2_3d.morpho b/test/modules/meshtools/refinecg2_3d.morpho new file mode 100644 index 000000000..5cd2ce677 --- /dev/null +++ b/test/modules/meshtools/refinecg2_3d.morpho @@ -0,0 +1,67 @@ +import meshtools + +fn point(lambda, vids, verts) { + var x = lambda[0]*verts.column(vids[0]) + for (j in 1...lambda.count()) x += lambda[j]*verts.column(vids[j]) + return x +} + +fn exact(x) { + return x[0]^3 - 0.5*x[0]*x[1] + 2*x[1]^2 + x[2]^3 - x[0]*x[2] + x[1]*x[2] +} + +fn preservesfield(field, oldfield, oldmesh) { + var mesh = field.mesh() + var fespace = field.finiteElementSpace() + var verts = mesh.vertexmatrix() + var cells = mesh.connectivitymatrix(0, 3) + var nodes = fespace.nodeCoords() + + for (cid in 0...mesh.count(3)) { + var vids = cells.rowindices(cid) + for (i in 0...fespace.count()) { + var lambda = nodes.column(i) + var x = point(lambda, vids, verts) + var oldlambda = oldmesh.barycentric(fespace.grade(), 0, x) + var expected = oldfield.evalElement(0, oldlambda) + var val = field.evalElement(cid, lambda) + if (abs(val-expected)>1e-10) return false + } + } + + return true +} + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvolume([0,1,2,3]) +var m = mb.build() +m.addgrade(1) +m.addgrade(2) +m.addgrade(3) + +var fespace = FiniteElementSpace("CG2", grade=3) +var f = Field(m, fn (x,y,z) exact([x,y,z]), finiteelementspace=fespace) +var oldm = m +var oldf = f +var mr = MeshRefiner([m, f]) +var refmap = mr.refine() + +m = refmap[m] +f = refmap[f] + +print m.count(0)==10 +// expect: true +print m.count(1)==25 +// expect: true +print m.count(2)==24 +// expect: true +print m.count(3)==8 +// expect: true +print f.shape()[0]==1 && f.shape()[1]==1 && f.shape()[2]==0 && f.shape()[3]==0 +// expect: true +print preservesfield(f, oldf, oldm) +// expect: true diff --git a/test/modules/meshtools/refinecg2_3d_2tets.morpho b/test/modules/meshtools/refinecg2_3d_2tets.morpho new file mode 100644 index 000000000..257540ccc --- /dev/null +++ b/test/modules/meshtools/refinecg2_3d_2tets.morpho @@ -0,0 +1,84 @@ +import meshtools + +fn point(lambda, vids, verts) { + var x = lambda[0]*verts.column(vids[0]) + for (j in 1...lambda.count()) x += lambda[j]*verts.column(vids[j]) + return x +} + +fn exact(x) { + return x[0]^3 - 0.5*x[0]*x[1] + 2*x[1]^2 + x[2]^3 - x[0]*x[2] + x[1]*x[2] +} + +fn contains(lambda, tol=1e-10) { + for (l in lambda) { + if (l<-tol || l>1+tol) return false + } + return true +} + +fn coarsevalue(field, mesh, x) { + for (cid in 0...mesh.count(3)) { + var lambda = mesh.barycentric(3, cid, x) + if (contains(lambda)) return field.evalElement(cid, lambda) + } + return nil +} + +fn preservesfield(field, oldfield, oldmesh) { + var mesh = field.mesh() + var fespace = field.finiteElementSpace() + var verts = mesh.vertexmatrix() + var cells = mesh.connectivitymatrix(0, 3) + var nodes = fespace.nodeCoords() + + for (cid in 0...mesh.count(3)) { + var vids = cells.rowindices(cid) + for (i in 0...fespace.count()) { + var lambda = nodes.column(i) + var x = point(lambda, vids, verts) + var expected = coarsevalue(oldfield, oldmesh, x) + if (expected==nil) return false + var val = field.evalElement(cid, lambda) + if (abs(val-expected)>1e-10) return false + } + } + + return true +} + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvertex([0,0,-1]) +mb.addvolume([0,1,2,3]) +mb.addvolume([0,1,2,4]) +var m = mb.build() +m.addgrade(1) +m.addgrade(2) +m.addgrade(3) + +var fespace = FiniteElementSpace("CG2", grade=3) +var f = Field(m, fn (x,y,z) exact([x,y,z]), finiteelementspace=fespace) +var oldm = m +var oldf = f +var mr = MeshRefiner([m, f]) +var refmap = mr.refine() + +m = refmap[m] +f = refmap[f] + +print m.count(0)==14 +// expect: true +print m.count(1)==41 +// expect: true +print m.count(2)==44 +// expect: true +print m.count(3)==16 +// expect: true +print f.shape()[0]==1 && f.shape()[1]==1 && f.shape()[2]==0 && f.shape()[3]==0 +// expect: true +print preservesfield(f, oldf, oldm) +// expect: true diff --git a/test/modules/meshtools/refinecg3.morpho b/test/modules/meshtools/refinecg3.morpho new file mode 100644 index 000000000..5e96833ce --- /dev/null +++ b/test/modules/meshtools/refinecg3.morpho @@ -0,0 +1,62 @@ +import meshtools + +fn point(lambda, vids, verts) { + var x = lambda[0]*verts.column(vids[0]) + for (j in 1...lambda.count()) x += lambda[j]*verts.column(vids[j]) + return x +} + +fn exact(x) { + return x[0]^3 - 0.5*x[0]*x[1] + 2*x[1]^2 +} + +fn preservesfield(field, oldfield, oldmesh) { + var mesh = field.mesh() + var fespace = field.finiteElementSpace() + var verts = mesh.vertexmatrix() + var faces = mesh.connectivitymatrix(0, 2) + var nodes = fespace.nodeCoords() + + for (fid in 0...mesh.count(2)) { + var vids = faces.rowindices(fid) + for (i in 0...fespace.count()) { + var lambda = nodes.column(i) + var x = point(lambda, vids, verts) + var oldlambda = oldmesh.barycentric(fespace.grade(), 0, x) + var expected = oldfield.evalElement(0, oldlambda) + var val = field.evalElement(fid, lambda) + if (abs(val-expected)>1e-10) return false + } + } + + return true +} + +var mb = MeshBuilder() +mb.addvertex([0,0]) +mb.addvertex([1,0]) +mb.addvertex([0,1]) +mb.addface([0,1,2]) +var m = mb.build() +m.addgrade(1) + +var fespace = FiniteElementSpace("CG3", grade=2) +var f = Field(m, fn (x,y) exact([x,y]), finiteelementspace=fespace) +var oldm = m +var oldf = f +var mr = MeshRefiner([m, f]) +var refmap = mr.refine() + +m = refmap[m] +f = refmap[f] + +print m.count(0)==6 +// expect: true +print m.count(1)==9 +// expect: true +print m.count(2)==4 +// expect: true +print f.shape()[0]==1 && f.shape()[1]==2 && f.shape()[2]==1 +// expect: true +print preservesfield(f, oldf, oldm) +// expect: true diff --git a/test/modules/meshtools/refinecg3_3d.morpho b/test/modules/meshtools/refinecg3_3d.morpho new file mode 100644 index 000000000..f713b271b --- /dev/null +++ b/test/modules/meshtools/refinecg3_3d.morpho @@ -0,0 +1,67 @@ +import meshtools + +fn point(lambda, vids, verts) { + var x = lambda[0]*verts.column(vids[0]) + for (j in 1...lambda.count()) x += lambda[j]*verts.column(vids[j]) + return x +} + +fn exact(x) { + return x[0]^3 - 0.5*x[0]*x[1] + 2*x[1]^2 + x[2]^3 - x[0]*x[2] + x[1]*x[2] +} + +fn preservesfield(field, oldfield, oldmesh) { + var mesh = field.mesh() + var fespace = field.finiteElementSpace() + var verts = mesh.vertexmatrix() + var cells = mesh.connectivitymatrix(0, 3) + var nodes = fespace.nodeCoords() + + for (cid in 0...mesh.count(3)) { + var vids = cells.rowindices(cid) + for (i in 0...fespace.count()) { + var lambda = nodes.column(i) + var x = point(lambda, vids, verts) + var oldlambda = oldmesh.barycentric(fespace.grade(), 0, x) + var expected = oldfield.evalElement(0, oldlambda) + var val = field.evalElement(cid, lambda) + if (abs(val-expected)>1e-10) return false + } + } + + return true +} + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvolume([0,1,2,3]) +var m = mb.build() +m.addgrade(1) +m.addgrade(2) +m.addgrade(3) + +var fespace = FiniteElementSpace("CG3", grade=3) +var f = Field(m, fn (x,y,z) exact([x,y,z]), finiteelementspace=fespace) +var oldm = m +var oldf = f +var mr = MeshRefiner([m, f]) +var refmap = mr.refine() + +m = refmap[m] +f = refmap[f] + +print m.count(0)==10 +// expect: true +print m.count(1)==25 +// expect: true +print m.count(2)==24 +// expect: true +print m.count(3)==8 +// expect: true +print f.shape()[0]==1 && f.shape()[1]==2 && f.shape()[2]==1 && f.shape()[3]==0 +// expect: true +print preservesfield(f, oldf, oldm) +// expect: true diff --git a/test/modules/meshtools/refinecg3_3d_2tets.morpho b/test/modules/meshtools/refinecg3_3d_2tets.morpho new file mode 100644 index 000000000..ca53f88a1 --- /dev/null +++ b/test/modules/meshtools/refinecg3_3d_2tets.morpho @@ -0,0 +1,84 @@ +import meshtools + +fn point(lambda, vids, verts) { + var x = lambda[0]*verts.column(vids[0]) + for (j in 1...lambda.count()) x += lambda[j]*verts.column(vids[j]) + return x +} + +fn exact(x) { + return x[0]^3 - 0.5*x[0]*x[1] + 2*x[1]^2 + x[2]^3 - x[0]*x[2] + x[1]*x[2] +} + +fn contains(lambda, tol=1e-10) { + for (l in lambda) { + if (l<-tol || l>1+tol) return false + } + return true +} + +fn coarsevalue(field, mesh, x) { + for (cid in 0...mesh.count(3)) { + var lambda = mesh.barycentric(3, cid, x) + if (contains(lambda)) return field.evalElement(cid, lambda) + } + return nil +} + +fn preservesfield(field, oldfield, oldmesh) { + var mesh = field.mesh() + var fespace = field.finiteElementSpace() + var verts = mesh.vertexmatrix() + var cells = mesh.connectivitymatrix(0, 3) + var nodes = fespace.nodeCoords() + + for (cid in 0...mesh.count(3)) { + var vids = cells.rowindices(cid) + for (i in 0...fespace.count()) { + var lambda = nodes.column(i) + var x = point(lambda, vids, verts) + var expected = coarsevalue(oldfield, oldmesh, x) + if (expected==nil) return false + var val = field.evalElement(cid, lambda) + if (abs(val-expected)>1e-10) return false + } + } + + return true +} + +var mb = MeshBuilder() +mb.addvertex([0,0,0]) +mb.addvertex([1,0,0]) +mb.addvertex([0,1,0]) +mb.addvertex([0,0,1]) +mb.addvertex([0,0,-1]) +mb.addvolume([0,1,2,3]) +mb.addvolume([0,1,2,4]) +var m = mb.build() +m.addgrade(1) +m.addgrade(2) +m.addgrade(3) + +var fespace = FiniteElementSpace("CG3", grade=3) +var f = Field(m, fn (x,y,z) exact([x,y,z]), finiteelementspace=fespace) +var oldm = m +var oldf = f +var mr = MeshRefiner([m, f]) +var refmap = mr.refine() + +m = refmap[m] +f = refmap[f] + +print m.count(0)==14 +// expect: true +print m.count(1)==41 +// expect: true +print m.count(2)==44 +// expect: true +print m.count(3)==16 +// expect: true +print f.shape()[0]==1 && f.shape()[1]==2 && f.shape()[2]==1 && f.shape()[3]==0 +// expect: true +print preservesfield(f, oldf, oldm) +// expect: true diff --git a/test/self/polymorphic_self_dispatch.morpho b/test/self/polymorphic_self_dispatch.morpho new file mode 100644 index 000000000..e95b76239 --- /dev/null +++ b/test/self/polymorphic_self_dispatch.morpho @@ -0,0 +1,18 @@ +// Dispatch with multiple resolutions + +class Base { + run() { return self.step() } + step() { return 0 } +} + +class WithField is Base { + init(f) { self.func = f } + step() { return self.func(1) } +} + +class Plain is Base { + step() { return 7 } +} + +print WithField(fn (x) x+1).run() // expect: 2 +print Plain().run() // expect: 7 diff --git a/test/slice/matrixSlicing.morpho b/test/slice/matrixSlicing.morpho index f1247ef72..75f031b43 100644 --- a/test/slice/matrixSlicing.morpho +++ b/test/slice/matrixSlicing.morpho @@ -23,108 +23,116 @@ print A[0..1,3] // expect: [ 7 ] // mix of list and int -print A[2,[0,1,2,1,2]] -// expect: [ 8 9 10 9 10 ] +// print A[2,[0,1,2,1,2]] +// notexpect: [ 8 9 10 9 10 ] +// Bug in method resolution -print A[0..1] +print A[0..1,0] // expect: [ 0 ] // expect: [ 4 ] +print A[-1..2,1..2] +// expect: [ 9 10 ] +// expect: [ 1 2 ] +// expect: [ 5 6 ] +// expect: [ 9 10 ] + // range out of bounds try{ - print A[-1..2,1..2] + print A[-20..2,1..2] } catch{ - "MtrxBnds": print "MtrxBnds" -// expect: MtrxBnds + "LnAlgMtrxIndxBnds": print "LnAlgMtrxIndxBnds" +// expect: LnAlgMtrxIndxBnds } try{ print A[0..3,1..2] } catch{ - "MtrxBnds": print "MtrxBnds" -// expect: MtrxBnds + "LnAlgMtrxIndxBnds": print "LnAlgMtrxIndxBnds" +// expect: LnAlgMtrxIndxBnds } +print A[0.0..2,1..2] +// expect: [ 1 2 ] +// expect: [ 5 6 ] +// expect: [ 9 10 ] -// range is not int -try{ - print A[0.0..2,1..2] -} catch{ - "MtrxInvldIndx": print "MtrxInvldIndx" -// expect: MtrxInvldIndx -} +print A[[-1,1,-1],1..2] +// expect: [ 9 10 ] +// expect: [ 5 6 ] +// expect: [ 9 10 ] // list is out of bounds try{ - print A[[-1,2,-1],1..2] + print A[[-4,2,-1],1..2] } catch{ - "MtrxBnds": print "MtrxBnds" -// expect: MtrxBnds + "LnAlgMtrxIndxBnds": print "LnAlgMtrxIndxBnds" +// expect: LnAlgMtrxIndxBnds } try{ print A[[100],1..2] } catch{ - "MtrxBnds": print "MtrxBnds" -// expect: MtrxBnds + "LnAlgMtrxIndxBnds": print "LnAlgMtrxIndxBnds" +// expect: LnAlgMtrxIndxBnds } -// list is not int -try{ - print A[[1,2,1],[0.2,0.1]] -} catch{ - "MtrxInvldIndx": print "MtrxInvldIndx" -// expect: MtrxInvldIndx -} +// index in list is not int +print A[[1,2,1],[0.2,0.1]] +// expect: [ 4 4 ] +// expect: [ 8 8 ] +// expect: [ 4 4 ] + +// index in list is not slicable try{ print A[[1,2,1],[[1]]] } catch{ - "MtrxInvldIndx": print "MtrxInvldIndx" -// expect: MtrxInvldIndx + "LnAlgMtrxInvldArg": print "LnAlgMtrxInvldArg" +// expect: LnAlgMtrxInvldArg } -// int + list but int is out of bounds -try{ - print A[[0,2,1],-1] -} catch{ - "MtrxBnds": print "MtrxBnds" -// expect: MtrxBnds -} +// int + list with negative indexing +print A[[0,2,1],-1] +// expect: [ 3 ] +// expect: [ 11 ] +// expect: [ 7 ] + try{ print A[[0,2,1],100] } catch{ - "MtrxBnds": print "MtrxBnds" -// expect: MtrxBnds -} -try{ - print A[[0,2,1],0.0] -} catch{ - "MtrxInvldIndx": print "MtrxInvldIndx" -// expect: MtrxInvldIndx + "LnAlgMtrxIndxBnds": print "LnAlgMtrxIndxBnds" +// expect: LnAlgMtrxIndxBnds } +print A[[0,2,1],0.0] +// expect: [ 0 ] +// expect: [ 8 ] +// expect: [ 4 ] + //wrong dim try{ print A[[1,2],[2,3],[0,1]] } catch{ - "MtrxInvldNumIndx": print "MtrxInvldNumIndx" -// expect: MtrxInvldNumIndx + "LnAlgInvldIndx": print "LnAlgInvldIndx" +// expect: LnAlgInvldIndx } -// garbage in +// garbage in try{ print A[A] } catch{ - "MtrxInvldIndx": print "MtrxInvldIndx" -// expect: MtrxInvldIndx + "LnAlgInvldIndx": print "LnAlgInvldIndx" +// expect: LnAlgInvldIndx + } try{ print A[nil] } catch{ - "MtrxInvldIndx": print "MtrxInvldIndx" -// expect: MtrxInvldIndx + "LnAlgInvldIndx": print "LnAlgInvldIndx" +// expect: LnAlgInvldIndx } + try{ A[1,2,3,4,5] } catch{ - "MtrxInvldNumIndx": print "MtrxInvldNumIndx" -// expect: MtrxInvldNumIndx + "LnAlgInvldIndx": print "LnAlgInvldIndx" +// expect: LnAlgInvldIndx } diff --git a/test/sparse/concatenate.morpho b/test/sparse/concatenate.morpho index 9ea350270..063af5773 100644 --- a/test/sparse/concatenate.morpho +++ b/test/sparse/concatenate.morpho @@ -24,4 +24,4 @@ print c // expect: [ 2 3 2 3 0 ] var c = Sparse([[a, b], [b, 0]]) -// expect error 'MtrxIncmptbl' +// expect error 'LnAlgMtrxIncmptbl' diff --git a/test/sparse/incompatible_add.morpho b/test/sparse/incompatible_add.morpho index 5e85bd394..8cbcb0146 100644 --- a/test/sparse/incompatible_add.morpho +++ b/test/sparse/incompatible_add.morpho @@ -4,4 +4,4 @@ var a = Sparse([[0,0,1],[1,1,1],[1,2,-1],[2,1,-1],[2,2,1],[3,3,1]]) var b = Sparse([[0,1,1],[1,0,1]]) print a+b -// expect Error: 'MtrxIncmptbl' +// expect Error: 'LnAlgMtrxIncmptbl' diff --git a/test/sparse/incompatible_mul.morpho b/test/sparse/incompatible_mul.morpho index 507502827..c6b4437cb 100644 --- a/test/sparse/incompatible_mul.morpho +++ b/test/sparse/incompatible_mul.morpho @@ -4,4 +4,4 @@ var a = Sparse([[0,0,1],[1,1,1],[1,2,-1],[2,1,-1],[2,2,1],[3,3,1]]) var b = Sparse([[0,1,1],[1,0,1]]) print a*b -// expect Error: 'MtrxIncmptbl' +// expect Error: 'LnAlgMtrxIncmptbl' diff --git a/test/sparse/set_row_indices.morpho b/test/sparse/set_row_indices.morpho index e26e15b18..6284a3af0 100644 --- a/test/sparse/set_row_indices.morpho +++ b/test/sparse/set_row_indices.morpho @@ -20,4 +20,4 @@ print a // expect: [ 1 -1 0 0 ] a.setrowindices(3, [1,1]) -// expect error 'MtrxIncmptbl' +// expect error 'LnAlgMtrxIncmptbl' diff --git a/test/sparse/sparse_dense_mul.morpho b/test/sparse/sparse_dense_mul.morpho index 3c4c2abb6..6e086085b 100644 --- a/test/sparse/sparse_dense_mul.morpho +++ b/test/sparse/sparse_dense_mul.morpho @@ -13,4 +13,4 @@ print A*B.transpose() // expect: [ 8 16 ] print A*B -// expect error 'MtrxIncmptbl' \ No newline at end of file +// expect error 'LnAlgMtrxIncmptbl' \ No newline at end of file diff --git a/test/sparse/sparse_dense_mul_dimensions.morpho b/test/sparse/sparse_dense_mul_dimensions.morpho index 19471eaed..af985fd8a 100644 --- a/test/sparse/sparse_dense_mul_dimensions.morpho +++ b/test/sparse/sparse_dense_mul_dimensions.morpho @@ -11,9 +11,9 @@ for (i in 0...N) { var b = Matrix(List(1..N)) print A.dimensions() // expect: [ 6, 3 ] -print b.dimensions() // expect: [ 3, 1 ] +print b.dimensions() // expect: (3, 1) -print (A*b).dimensions() // expect: [ 6, 1 ] +print (A*b).dimensions() // expect: (6, 1) print A*b // expect: [ 1 ] diff --git a/test/string/err_split_args.morpho b/test/string/err_split_args.morpho new file mode 100644 index 000000000..011f0ceb8 --- /dev/null +++ b/test/string/err_split_args.morpho @@ -0,0 +1,4 @@ +// Split requires a separator argument + +print "Hello world".split() +// expect error 'MltplDsptchFld' diff --git a/test/string/err_split_args2.morpho b/test/string/err_split_args2.morpho new file mode 100644 index 000000000..443c078de --- /dev/null +++ b/test/string/err_split_args2.morpho @@ -0,0 +1,3 @@ + +print "Hello world".split(2) +// expect error 'MltplDsptchFld' diff --git a/test/string/err_split_args3.morpho b/test/string/err_split_args3.morpho new file mode 100644 index 000000000..8e0cd01f8 --- /dev/null +++ b/test/string/err_split_args3.morpho @@ -0,0 +1,4 @@ +// You can not add extra arguments to a function + +print "Hello world".split(" ", 2) +// expect error 'MltplDsptchFld' diff --git a/test/string/err_split_args4.morpho b/test/string/err_split_args4.morpho new file mode 100644 index 000000000..a20dc5a9c --- /dev/null +++ b/test/string/err_split_args4.morpho @@ -0,0 +1,5 @@ +print "Hello world".split(" ") +// expect: [ Hello, world ] + +print "Hello world".split() +// expect error 'MltplDsptchFld' diff --git a/test/string/index_neg.morpho b/test/string/index_neg.morpho new file mode 100644 index 000000000..c58dee6ee --- /dev/null +++ b/test/string/index_neg.morpho @@ -0,0 +1,5 @@ +var s = "Hello" + +print s[-1] +// expect Error 'IndxBnds' + diff --git a/test/string/substring.morpho b/test/string/substring.morpho new file mode 100644 index 000000000..ffd583410 --- /dev/null +++ b/test/string/substring.morpho @@ -0,0 +1,14 @@ +var str = "Hi Hi Hello \U0001F98B" +print str.count() +// expect: 13 + +print str.substring(0,-4) +// expect: +print str.substring(0,4) +// expect: Hi H +print str.substring(0,13) +// expect: Hi Hi Hello 🦋 +print str.substring(0,20) +// expect: Hi Hi Hello 🦋 +print str.substring(-2,5) +// expect: Hi Hi \ No newline at end of file diff --git a/test/super/super_init_with_internal_behavior.morpho b/test/super/super_init_with_internal_behavior.morpho new file mode 100644 index 000000000..b2ccb14fa --- /dev/null +++ b/test/super/super_init_with_internal_behavior.morpho @@ -0,0 +1,31 @@ +// Complex initializer + +var errChebyshevOrderInconsistent = Error("ChebyshevOrder", "Orders are inconsistent") + +class BaseMap { + init(R, G, B) { + self.R = R + self.G = G + self.B = B + self.order = R.count() + + if (G.count()!=self.order || B.count()!=self.order) errChebyshevOrderInconsistent.throw() + } + + report() { + return [self.order, self.R[0], self.G[0], self.B[0]] + } +} + +class DerivedMap is BaseMap { + init() { + super.init( + [1, 2, 3], + [4, 5, 6], + [7, 8, 9] + ) + } +} + +var m = DerivedMap() +print m.report() // expect: [ 3, 1, 4, 7 ] diff --git a/test/system/setworkingfolder.morpho b/test/system/setworkingfolder.morpho new file mode 100644 index 000000000..f5b8c0832 --- /dev/null +++ b/test/system/setworkingfolder.morpho @@ -0,0 +1,8 @@ +// Test setworkingfolder + +var a = System.workingfolder() +System.setworkingfolder(a) +var b = System.workingfolder() + +print (a==b) +// expect: true diff --git a/test/system/workingfolder.morpho b/test/system/workingfolder.morpho new file mode 100644 index 000000000..bfe60bab2 --- /dev/null +++ b/test/system/workingfolder.morpho @@ -0,0 +1,4 @@ +// Test workingfolder + +print isstring(System.workingfolder()) +// expect: true diff --git a/test/test.py b/test/test.py index 7fdaad273..acbeff794 100755 --- a/test/test.py +++ b/test/test.py @@ -8,7 +8,7 @@ # Expectations are coded into comments in the input file as follows: # import necessary modules -import os, glob, sys +import os, glob, sys, subprocess import regex as rx from functools import reduce import operator @@ -125,8 +125,9 @@ def test(file,testLog,CI): #Get the expected output expected=getexpect(file) - # Run the test - os.system(command + ' ' +file + ' > ' + tmp) + # Run the test and capture the exit status + with open(tmp, 'w', encoding="utf8") as outfile: + result = subprocess.run(command.split() + [file], stdout=outfile, stderr=subprocess.STDOUT) # If we produced output if os.path.exists(tmp): @@ -134,13 +135,14 @@ def test(file,testLog,CI): out=getoutput(tmp) # Was it expected? - if(expected==out): + if(result.returncode==0 and expected==out): if not CI: print(stylize("Passed",colored.fg("green"))) ret = 1 else: if not CI: print(stylize("Failed",colored.fg("red"))) + print(" Return code: ", result.returncode) print(" Expected: ", expected) print(" Output: ", out) else: @@ -159,6 +161,7 @@ def test(file,testLog,CI): print(" Expected: ", expected[testNum], file = testLog) print(" Output: ", out[testNum], file = testLog) else: + print(" Return code: ", result.returncode, file = testLog) print(" Expected: ", expected, file = testLog) print(" Output: ", out, file = testLog) diff --git a/test/tuple/tuple_order.morpho b/test/tuple/tuple_order.morpho new file mode 100644 index 000000000..62d1925fb --- /dev/null +++ b/test/tuple/tuple_order.morpho @@ -0,0 +1,6 @@ +// Tuple order + +var t = ( 3, 2, 1 ) +print t.order() +// expect: (2, 1, 0) + diff --git a/test/tuple/tuple_reverse.morpho b/test/tuple/tuple_reverse.morpho new file mode 100644 index 000000000..f894b82c1 --- /dev/null +++ b/test/tuple/tuple_reverse.morpho @@ -0,0 +1,12 @@ +// Tuple reverse + +var t = ( 1, 2, 3 ) +print t.reverse() +// expect: (3, 2, 1) +print t +// expect: (1, 2, 3) + +var u = ( 1, 2, 3, 4 ) +print u.reverse() +// expect: (4, 3, 2, 1) + diff --git a/test/tuple/tuple_roll.morpho b/test/tuple/tuple_roll.morpho new file mode 100644 index 000000000..792d84ad0 --- /dev/null +++ b/test/tuple/tuple_roll.morpho @@ -0,0 +1,18 @@ +// Tuple roll + +var t = ( 1, 2, 3 ) + +for (n in -4..4) { + print t.roll(n) +} + +// expect: (2, 3, 1) +// expect: (1, 2, 3) +// expect: (3, 1, 2) +// expect: (2, 3, 1) +// expect: (1, 2, 3) +// expect: (3, 1, 2) +// expect: (2, 3, 1) +// expect: (1, 2, 3) +// expect: (3, 1, 2) + diff --git a/test/tuple/tuple_sort.morpho b/test/tuple/tuple_sort.morpho new file mode 100644 index 000000000..9757d05ed --- /dev/null +++ b/test/tuple/tuple_sort.morpho @@ -0,0 +1,10 @@ +// Tuple sort + +var a = ( 4, 3, 2, 7, 8, 1, 10, 9, 6, 5 ) +var b = a.sort() + +print b +// expect: (1, 2, 3, 4, 5, 6, 7, 8, 9, 10) + +print a==b +// expect: false diff --git a/test/tuple/tuple_sort_fn.morpho b/test/tuple/tuple_sort_fn.morpho new file mode 100644 index 000000000..555a35ff5 --- /dev/null +++ b/test/tuple/tuple_sort_fn.morpho @@ -0,0 +1,14 @@ +// Tuple sort with comparison function + +fn cmp(a, b) { + return -(a-b) +} + +var a = ( 4, 3, 2, 7, 8, 1, 10, 9, 6, 5 ) +var b = a.sort(cmp) + +print b +// expect: (10, 9, 8, 7, 6, 5, 4, 3, 2, 1) + +print a==b +// expect: false diff --git a/test/tuple/tuple_tostring.morpho b/test/tuple/tuple_tostring.morpho new file mode 100644 index 000000000..6f9a71eda --- /dev/null +++ b/test/tuple/tuple_tostring.morpho @@ -0,0 +1,5 @@ +// Tuple tostring + +var t = ( 1, 2, 3 ) +print t.tostring() +// expect: (1, 2, 3) diff --git a/test/types/demos/shapes.morpho b/test/types/demos/shapes.morpho new file mode 100644 index 000000000..fddba27fd --- /dev/null +++ b/test/types/demos/shapes.morpho @@ -0,0 +1,88 @@ +// Demonstrate use of type system + +import constants + +class Shape { } + +class Circle is Shape { + init(Float radius) { + self.radius = radius + } +} + +class Rectangle is Shape { + init(Float width, Float height) { + self.width = width + self.height = height + } +} + +class Triangle is Shape { + init(Float base, Float height) { + self.base = base + self.height = height + } +} + +class Polygon is Shape { + init(Int sides, Float sideLength) { + self.sides = sides + self.sideLength = sideLength + } +} + +// Use multiple dispatch to compute area +fn area(Circle c) { return Pi*c.radius*c.radius} +fn area(Rectangle r) { return r.width*r.height } +fn area(Triangle t) { return t.base*t.height/2 } +fn area(Polygon p) { + var apothem = p.sideLength / (2 * tan(Pi / p.sides)) + return 0.5 * p.sides * p.sideLength * apothem +} + +// Compare shapes +fn compare_shapes(Circle c1, Circle c2) { + if (c1.radius > c2.radius) return "first circle is larger" + if (c1.radius < c2.radius) return "second circle is larger" + return "circles are equal"; +} + +fn compare_shapes(Rectangle r1, Rectangle r2) { + var area1 = area(r1) + var area2 = area(r2) + + if (area1 > area2) return "first rectangle is larger" + if (area1 < area2) return "second rectangle is larger" + return "rectangles are equal" +} + +fn compare_shapes(Circle c1, Rectangle r2) { + var area1 = area(c1) + var area2 = area(r2) + + if (area1 > area2) return "circle is larger" + if (area1 < area2) return "rectangle is larger" + return "shapes have equal area" +} + +fn compare_shapes(Shape a, Shape b) { + return "cannot compare different shape types"; +} + +Shape circle = Circle(5.0) +Shape rectangle = Rectangle(10.0, 8.0) + +{ + Shape triangle = Triangle(6.0, 4.0) + Shape polygon = Polygon(6, 3.0) + + area(circle) + area(rectangle) + area(triangle) + area(polygon) +} + +String comparison = compare_shapes(circle, rectangle) +print "Shape comparison: ${comparison}" + +// expect: Shape comparison: rectangle is larger \ No newline at end of file diff --git a/test/types/multiple_dispatch/callable.morpho b/test/types/multiple_dispatch/callable.morpho new file mode 100644 index 000000000..c9be50b87 --- /dev/null +++ b/test/types/multiple_dispatch/callable.morpho @@ -0,0 +1,16 @@ +// Dispatch on Callable + +fn f(Callable g, x) { + print g(x) +} + +fn f(Float x, y) { + print x+y +} + +fn h(x) { return 1 } + +f(h, 0) // expect: 1 +f(cos, 0) // expect: 1 + +f("H", 0) // expect error 'MltplDsptchFld' diff --git a/test/types/multiple_dispatch/callable_closure.morpho b/test/types/multiple_dispatch/callable_closure.morpho new file mode 100644 index 000000000..496543502 --- /dev/null +++ b/test/types/multiple_dispatch/callable_closure.morpho @@ -0,0 +1,21 @@ +// Dispatch on Callable + +fn f(Callable g, x) { + print g(x) +} + +fn f(Float x, y) { + print x+y +} + +fn m(p) { + fn g(x) { + return p(x) + } + + return g +} + +var p = m(cos) + +f(p, 0) // expect: 1 diff --git a/test/types/multiple_dispatch/callable_closure_upvaluepriority.morpho b/test/types/multiple_dispatch/callable_closure_upvaluepriority.morpho new file mode 100644 index 000000000..54f4bd79a --- /dev/null +++ b/test/types/multiple_dispatch/callable_closure_upvaluepriority.morpho @@ -0,0 +1,21 @@ +// Dispatch on Callable + +fn f(Callable g, x) { + print g(x) +} + +fn f(Float x, y) { + print x+y +} + +fn m(f) { + fn g(x) { + return f(x) + } + + return g +} + +var p = m(cos) + +f(p, 0) // expect: 1 diff --git a/test/types/multiple_dispatch/callable_invocation.morpho b/test/types/multiple_dispatch/callable_invocation.morpho new file mode 100644 index 000000000..c35087365 --- /dev/null +++ b/test/types/multiple_dispatch/callable_invocation.morpho @@ -0,0 +1,17 @@ +// Dispatch on Callable + +fn f(Callable g, x) { + print g(x) +} + +fn f(Float x, y) { + print x+y +} + +class Foo { + boo(x) { + return 2*x + } +} + +f(Foo().boo, 1) // expect: 2 diff --git a/test/types/multiple_dispatch/callable_metafunction.morpho b/test/types/multiple_dispatch/callable_metafunction.morpho new file mode 100644 index 000000000..6c13728c2 --- /dev/null +++ b/test/types/multiple_dispatch/callable_metafunction.morpho @@ -0,0 +1,16 @@ +// Dispatch on Callable + +fn f(Callable g, x) { + print g(x) +} + +fn f(Float x, y) { + print x+y +} + +fn g(Int x) { return 2*x } + +fn g(Float x) { return x/2 } + +f(g, 1) // expect: 2 +f(g, 2.5) // expect: 1.25 diff --git a/test/types/multiple_dispatch/check_multiple.morpho b/test/types/multiple_dispatch/check_multiple.morpho new file mode 100644 index 000000000..e7f66e592 --- /dev/null +++ b/test/types/multiple_dispatch/check_multiple.morpho @@ -0,0 +1,18 @@ + +class A {} + +class B {} + +fn f(A x, A y) { return 1 } + +fn f(A x, B y) { return 2 } + +fn f(x, y) { return 1.5 } + +print f(A(), A()) // expect: 1 + +print f(0, 0) // expect: 1.5 + +print f(A(), 1) // expect: 1.5 + +print f(A(), B()) // expect: 2 diff --git a/test/types/multiple_dispatch/diamond_linearization.morpho b/test/types/multiple_dispatch/diamond_linearization.morpho new file mode 100644 index 000000000..dde99a13c --- /dev/null +++ b/test/types/multiple_dispatch/diamond_linearization.morpho @@ -0,0 +1,26 @@ +// Diamond inheritance linearization in dispatch + +class A {} + +class B is A {} + +class C is A {} + +class D is B with C {} + +class E is C with B {} + +fn f(B x) { + return "B" +} + +fn f(C x) { + return "C" +} + +print f(D()) +// expect: B + +print f(E()) +// expect: C + diff --git a/test/types/multiple_dispatch/dispatch_nargs_variadic.morpho b/test/types/multiple_dispatch/dispatch_nargs_variadic.morpho new file mode 100644 index 000000000..cfc3ce746 --- /dev/null +++ b/test/types/multiple_dispatch/dispatch_nargs_variadic.morpho @@ -0,0 +1,5 @@ +// Dispatch on number of arguments + +print sin(1,2,3) + +// expect error 'ExpctArgNm' diff --git a/test/types/multiple_dispatch/inheritance_linearization_order.morpho b/test/types/multiple_dispatch/inheritance_linearization_order.morpho new file mode 100644 index 000000000..9431508fb --- /dev/null +++ b/test/types/multiple_dispatch/inheritance_linearization_order.morpho @@ -0,0 +1,24 @@ +// Multiple inheritance linearization order in dispatch + +class A {} + +class D {} + +class E is A with D {} + +class F is D with A {} + +fn f(A x) { + return "A" +} + +fn f(D x) { + return "D" +} + +print f(E()) +// expect: A + +print f(F()) +// expect: D + diff --git a/test/types/multiple_dispatch/multiple_inheritance_wildcard.morpho b/test/types/multiple_dispatch/multiple_inheritance_wildcard.morpho new file mode 100644 index 000000000..53142b741 --- /dev/null +++ b/test/types/multiple_dispatch/multiple_inheritance_wildcard.morpho @@ -0,0 +1,28 @@ +// Multiple inheritance specificity beats wildcard fallback + +class A {} + +class D {} + +class E is A with D {} + +class F {} + +fn f(x) { + return "_" +} + +fn f(A x) { + return "A" +} + +fn f(D x) { + return "D" +} + +print f(E()) +// expect: A + +print f(F()) +// expect: _ + diff --git a/test/types/multiple_dispatch/namespace_for_new.morpho b/test/types/multiple_dispatch/namespace_for_new.morpho index 672f6e36a..f32fe3c43 100644 --- a/test/types/multiple_dispatch/namespace_for_new.morpho +++ b/test/types/multiple_dispatch/namespace_for_new.morpho @@ -6,8 +6,7 @@ import "namespace.xmorpho" for f fn f(Matrix a) { print a.dimensions() - } f(Matrix(2,2)) -// expect: [ 2, 2 ] +// expect: (2, 2) diff --git a/test/types/multiple_dispatch/nparams_typecheck.morpho b/test/types/multiple_dispatch/nparams_typecheck.morpho new file mode 100644 index 000000000..e877a9d2f --- /dev/null +++ b/test/types/multiple_dispatch/nparams_typecheck.morpho @@ -0,0 +1,12 @@ +// Variable numbers of parameters with typecheck + +fn f(Int x) { + return 0 +} + +fn f(...x) { + return 1 +} + +print f(1) // expect: 0 +print f(1,2) // expect: 1 diff --git a/test/types/multiple_dispatch/specificity_ambiguity.morpho b/test/types/multiple_dispatch/specificity_ambiguity.morpho new file mode 100644 index 000000000..dea7a3771 --- /dev/null +++ b/test/types/multiple_dispatch/specificity_ambiguity.morpho @@ -0,0 +1,17 @@ +// Specificity ambiguity across multiple parameters + +class A {} + +class B is A {} + +fn f(A x, B y) { + return "AB" +} + +fn f(B x, A y) { + return "BA" +} + +print f(B(), B()) +// expect error 'MltplDisptchAmbg' + diff --git a/test/types/multiple_dispatch/varg_specificity.morpho b/test/types/multiple_dispatch/varg_specificity.morpho new file mode 100644 index 000000000..225bb1d73 --- /dev/null +++ b/test/types/multiple_dispatch/varg_specificity.morpho @@ -0,0 +1,26 @@ +// Variadic dispatch specificity + +fn f(Int x) { + return "Int" +} + +fn f(Int x, ...rest) { + return "Int..." +} + +fn f(...rest) { + return "..." +} + +print f() +// expect: ... + +print f(1) +// expect: Int + +print f(1, "x") +// expect: Int... + +print f("x") +// expect: ... + diff --git a/test/types/multiple_dispatch/wildcard_dominance.morpho b/test/types/multiple_dispatch/wildcard_dominance.morpho new file mode 100644 index 000000000..66300b7cb --- /dev/null +++ b/test/types/multiple_dispatch/wildcard_dominance.morpho @@ -0,0 +1,29 @@ +// Typed overloads dominate untyped wildcard overloads + +class A {} + +class B is A {} + +class C {} + +fn f(x) { + return "_" +} + +fn f(A x) { + return "A" +} + +fn f(B x) { + return "B" +} + +print f(A()) +// expect: A + +print f(B()) +// expect: B + +print f(C()) +// expect: _ + diff --git a/test/types/multiple_dispatch/wildcard_multiple_args.morpho b/test/types/multiple_dispatch/wildcard_multiple_args.morpho new file mode 100644 index 000000000..76c886599 --- /dev/null +++ b/test/types/multiple_dispatch/wildcard_multiple_args.morpho @@ -0,0 +1,34 @@ +// Wildcard dominance across multiple arguments + +class A {} + +class B {} + +fn f(x, y) { + return "__" +} + +fn f(A x, y) { + return "A_" +} + +fn f(x, A y) { + return "_A" +} + +fn f(A x, A y) { + return "AA" +} + +print f(A(), A()) +// expect: AA + +print f(A(), B()) +// expect: A_ + +print f(B(), A()) +// expect: _A + +print f(B(), B()) +// expect: __ + diff --git a/test/types/type_add.morpho b/test/types/type_add.morpho new file mode 100644 index 000000000..06cc6ffb3 --- /dev/null +++ b/test/types/type_add.morpho @@ -0,0 +1,7 @@ +// Type propagation through add + +{ + var A = Matrix([1]) + Matrix b = A+1 + print b // expect: [ 2 ] +} \ No newline at end of file diff --git a/test/types/type_addr.morpho b/test/types/type_addr.morpho new file mode 100644 index 000000000..0f5a61e45 --- /dev/null +++ b/test/types/type_addr.morpho @@ -0,0 +1,7 @@ +// Type propagation through add + +{ + var A = Matrix([1]) + Matrix b = 1+A + print b // expect: [ 2 ] +} \ No newline at end of file diff --git a/test/types/type_arithmetic_runtime.morpho b/test/types/type_arithmetic_runtime.morpho new file mode 100644 index 000000000..7df78bded --- /dev/null +++ b/test/types/type_arithmetic_runtime.morpho @@ -0,0 +1,13 @@ +// Runtime typecheck + +fn f(x) { + return x +} + +{ + Int b = 1 + f(1) + + print b +} + +// expect: 2 diff --git a/test/types/type_array_operations.morpho b/test/types/type_array_operations.morpho new file mode 100644 index 000000000..eaefa0e22 --- /dev/null +++ b/test/types/type_array_operations.morpho @@ -0,0 +1,15 @@ +// Type checking with array operations + +Array arr = Array(3) +arr[0] = 1 +arr[1] = 2 +arr[2] = 3 + +Int sum = 0 +for (i in 0...arr.count()) { + Int val = arr[i] // Type should be preserved + sum = sum + val +} +print sum // expect: 6 + + diff --git a/test/types/type_casting.morpho b/test/types/type_casting.morpho new file mode 100644 index 000000000..af9c62247 --- /dev/null +++ b/test/types/type_casting.morpho @@ -0,0 +1,8 @@ +// Type checking with explicit type casting + +Float f = 3.14 +Int i = Int(f) // Explicit cast +Float g = Float(i) // Back to float + +print i // expect: 3 +print g // expect: 3 diff --git a/test/types/type_closure_propagation.morpho b/test/types/type_closure_propagation.morpho new file mode 100644 index 000000000..98f2c42e5 --- /dev/null +++ b/test/types/type_closure_propagation.morpho @@ -0,0 +1,12 @@ +// Type propagation through closure + +fn outer(Int x) { + fn inner(Int y) { + Int result = x + y + return result + } + return inner +} + +Int result = outer(1)(2) +print result // expect: 3 diff --git a/test/types/type_closure_propagation_stepwise.morpho b/test/types/type_closure_propagation_stepwise.morpho new file mode 100644 index 000000000..93f34af8f --- /dev/null +++ b/test/types/type_closure_propagation_stepwise.morpho @@ -0,0 +1,13 @@ +// Type propagation through deeply nested closures + +fn outer(Int x) { + fn inner(Int y) { + Int result = x + y + return result + } + return inner +} + +var inner_fn = outer(1) +Int result = inner_fn(2) +print result // expect: 3 diff --git a/test/types/type_complex_inheritance.morpho b/test/types/type_complex_inheritance.morpho new file mode 100644 index 000000000..7eefb2014 --- /dev/null +++ b/test/types/type_complex_inheritance.morpho @@ -0,0 +1,37 @@ +// Type checking with diamond inheritance: +// A +// / \ +// B C +// | | +// D E +// | | +// F G +// \ / +// H + +class A { } +class B is A { } +class C is A { } +class D is B { } +class E is C { } +class F is D { } +class G is E { } +class H is F with G {} + +fn process(A a) { + return a +} + +A a1 = B() +A a2 = C() +A a3 = D() +A a4 = F() +A a5 = G() +A a6 = H() + +print process(a1) // expect: +print process(a2) // expect: +print process(a3) // expect: +print process(a4) // expect: +print process(a5) // expect: +print process(a6) // expect: diff --git a/test/types/type_declaration_namespace.morpho b/test/types/type_declaration_namespace.morpho new file mode 100644 index 000000000..0e9d303a7 --- /dev/null +++ b/test/types/type_declaration_namespace.morpho @@ -0,0 +1,13 @@ + +import "type_namespace.xmorpho" as ns + +class Cow is ns.Pet { + moo() { print "${self.name} moos" } +} + +ns.Pet a = ns.Cat("Phineas"), + b = ns.Dog("Fido"), + c = Cow("Ermintrude") + +a.hiss() // expect: Phineas hisses +c.moo() // expect: Ermintrude moos diff --git a/test/types/type_dictionary_operations.morpho b/test/types/type_dictionary_operations.morpho new file mode 100644 index 000000000..7385d87d0 --- /dev/null +++ b/test/types/type_dictionary_operations.morpho @@ -0,0 +1,12 @@ +// Type checking with dictionary operations + +Dictionary dict = { "a": 1, "b": 2, "c": 3 } + +Int total = 0 +for (key in dict.keys()) { + Int val = dict[key] // Type should be inferred + total = total + val +} +print total // expect: 6 + + diff --git a/test/types/type_do_while.morpho b/test/types/type_do_while.morpho new file mode 100644 index 000000000..af12737b2 --- /dev/null +++ b/test/types/type_do_while.morpho @@ -0,0 +1,13 @@ +// Type checking with do-while loops + +Int i = 0 +Int count = 0 + +do { + count = count + 1 + i = i + 1 +} while (i < 3) + +print count // expect: 3 + + diff --git a/test/types/type_early_return.morpho b/test/types/type_early_return.morpho new file mode 100644 index 000000000..9d63cfd65 --- /dev/null +++ b/test/types/type_early_return.morpho @@ -0,0 +1,16 @@ +// Type checking with multiple return paths + +fn check(Int x) { + if (x < 0) { + return 0 // Early return + } + Int result = x * 2 + return result +} + +Int a = check(5) +Int b = check(-1) +print a // expect: 10 +print b // expect: 0 + + diff --git a/test/types/type_forin_index.morpho b/test/types/type_forin_index.morpho new file mode 100644 index 000000000..05e82f6a5 --- /dev/null +++ b/test/types/type_forin_index.morpho @@ -0,0 +1,10 @@ +// Index variable is correctly typed in for..in loop + +for (x, k in [1,2,3]) { + Int i = k + print i +} + +// expect: 0 +// expect: 1 +// expect: 2 diff --git a/test/types/type_from_indexed.morpho b/test/types/type_from_indexed.morpho new file mode 100644 index 000000000..c6d1b7ecd --- /dev/null +++ b/test/types/type_from_indexed.morpho @@ -0,0 +1,7 @@ +// Retrieve from index with typecheck + +var a = [1,2,3] + +Int b = a[0] + +print b // expect: 1 diff --git a/test/types/type_from_upvalue.morpho b/test/types/type_from_upvalue.morpho new file mode 100644 index 000000000..4d7c50adf --- /dev/null +++ b/test/types/type_from_upvalue.morpho @@ -0,0 +1,15 @@ +// Retrieve type from upvalue + +fn f(x) { + Int y = Int(x) + + fn g() { + Int z = y + 1 + return z + } + + return g +} + +print f(1)() // expect: 2 +print f(2)() // expect: 3 diff --git a/test/types/type_from_upvalue_runtime.morpho b/test/types/type_from_upvalue_runtime.morpho new file mode 100644 index 000000000..4e9384e21 --- /dev/null +++ b/test/types/type_from_upvalue_runtime.morpho @@ -0,0 +1,15 @@ +// Retrieve type from upvalue with typecheck + +fn f(x) { + var y = x + + fn g() { + Int z = y + return z + } + + return g +} + +print f(1)() // expect: 1 +print f(2)() // expect: 2 diff --git a/test/types/type_global_runtime.morpho b/test/types/type_global_runtime.morpho new file mode 100644 index 000000000..8f0dc1faa --- /dev/null +++ b/test/types/type_global_runtime.morpho @@ -0,0 +1,11 @@ +// Runtime typecheck + +fn foo(x, y) { + return x + y +} + +var a = foo(1,2) +{ + Int b = a +} + diff --git a/test/types/type_interpolation.morpho b/test/types/type_interpolation.morpho new file mode 100644 index 000000000..08d796ffc --- /dev/null +++ b/test/types/type_interpolation.morpho @@ -0,0 +1,7 @@ +// Type propagation from interpolation + +{ + var a = 1 + String b = "a=${a}" + print b // expect: a=1 +} diff --git a/test/types/type_loop_break_continue.morpho b/test/types/type_loop_break_continue.morpho new file mode 100644 index 000000000..30ef73844 --- /dev/null +++ b/test/types/type_loop_break_continue.morpho @@ -0,0 +1,13 @@ +// Type checking with break and continue + +Int sum = 0 +for (Int i = 0; i < 10; i = i + 1) { + if (i == 5) { + continue // Type should be preserved + } + if (i == 8) { + break // Type should be preserved + } + sum = sum + i +} +print sum // expect: 23 diff --git a/test/types/type_loop_interior.morpho b/test/types/type_loop_interior.morpho new file mode 100644 index 000000000..d0308fd58 --- /dev/null +++ b/test/types/type_loop_interior.morpho @@ -0,0 +1,9 @@ +// Interior type in loop + +for (Int i=0; i<3; i+=1) { + print i +} + +// expect: 0 +// expect: 1 +// expect: 2 diff --git a/test/types/type_matrix_operations.morpho b/test/types/type_matrix_operations.morpho new file mode 100644 index 000000000..2caff884c --- /dev/null +++ b/test/types/type_matrix_operations.morpho @@ -0,0 +1,12 @@ +// Type checking with matrix operations + +Matrix m1 = Matrix(2, 2) +m1[0,0] = 1 +m1[0,1] = 2 +m1[1,0] = 3 +m1[1,1] = 4 + +Matrix m2 = m1 + m1 +Float val = m2[0,0] + +print val // expect: 2 diff --git a/test/types/type_method_call.morpho b/test/types/type_method_call.morpho new file mode 100644 index 000000000..c7d9b6451 --- /dev/null +++ b/test/types/type_method_call.morpho @@ -0,0 +1,7 @@ +// Type propagation through a method call + +Array a = Array(2,2) + +Int b = a.count() + +print b // expect: 4 diff --git a/test/types/type_method_chaining.morpho b/test/types/type_method_chaining.morpho new file mode 100644 index 000000000..4af0e8ca5 --- /dev/null +++ b/test/types/type_method_chaining.morpho @@ -0,0 +1,12 @@ +// Type propagation through method chains + +class Counter { + init() { self.value = 0 } + add(Int x) { self.value = self.value + x; return self } + get() { return self.value } +} + +Int result = Counter().add(5).add(3).get() +print result // expect: 8 + + diff --git a/test/types/type_multiple_declarations.morpho b/test/types/type_multiple_declarations.morpho new file mode 100644 index 000000000..df14974a0 --- /dev/null +++ b/test/types/type_multiple_declarations.morpho @@ -0,0 +1,7 @@ +// Multiple simultaneous declarations + +List a = [], b = [], c = [] + +print a // expect: [ ] +print b // expect: [ ] +print c // expect: [ ] diff --git a/test/types/type_multiple_dispatch_edge_cases.morpho b/test/types/type_multiple_dispatch_edge_cases.morpho new file mode 100644 index 000000000..c3a1a7507 --- /dev/null +++ b/test/types/type_multiple_dispatch_edge_cases.morpho @@ -0,0 +1,23 @@ +// Multiple dispatch with inheritance + +class Animal { } +class Dog is Animal { } +class Cat is Animal { } + +fn speak(Animal a) { + return "animal sound" +} + +fn speak(Dog d) { + return "woof" +} + +fn speak(Cat c) { + return "meow" +} + +print speak(Animal()) // expect: animal sound +print speak(Dog()) // expect: woof +print speak(Cat()) // expect: meow + + diff --git a/test/types/type_multiple_return_types_runtime.morpho b/test/types/type_multiple_return_types_runtime.morpho new file mode 100644 index 000000000..a1c49006b --- /dev/null +++ b/test/types/type_multiple_return_types_runtime.morpho @@ -0,0 +1,13 @@ +// Function with multiple return types yields dynamic typecheck + +fn multi(x) { + if (x>0) return 1 + return "foo" +} + +Int a = multi(2) +print a +// expect: 1 + +a = multi(-1) +// expect error 'TypeChk' diff --git a/test/types/type_narrowing_conditional.morpho b/test/types/type_narrowing_conditional.morpho new file mode 100644 index 000000000..9194cc1d4 --- /dev/null +++ b/test/types/type_narrowing_conditional.morpho @@ -0,0 +1,17 @@ +// Type narrowing through conditional checks + +fn process(x) { + if (isint(x)) { + Int i = x // Should work - type narrowed + return i * 2 + } else if (isstring(x)) { + String s = x // Should work - type narrowed + return s + } + return nil +} + +print process(5) // expect: 10 +print process("hi") // expect: hi + + diff --git a/test/types/type_nested_closure_propagation.morpho b/test/types/type_nested_closure_propagation.morpho new file mode 100644 index 000000000..32aa7e629 --- /dev/null +++ b/test/types/type_nested_closure_propagation.morpho @@ -0,0 +1,16 @@ +// Type propagation through deeply nested closures + +fn outer(Int x) { + fn middle(Int y) { + fn inner(Int z) { + Int result = x + y + z + return result + } + return inner + } + return middle +} + +Int result = outer(1)(2)(3) +print result // expect: 6 + diff --git a/test/types/type_no_initializer.morpho b/test/types/type_no_initializer.morpho new file mode 100644 index 000000000..8aeb6838c --- /dev/null +++ b/test/types/type_no_initializer.morpho @@ -0,0 +1,7 @@ +// No initializer for typed variable + +{ + Int a +} + +// expect error 'MssngIntlzr' diff --git a/test/types/type_not.morpho b/test/types/type_not.morpho new file mode 100644 index 000000000..f82b5bec7 --- /dev/null +++ b/test/types/type_not.morpho @@ -0,0 +1,7 @@ +// Type propagation through NOT + +var a = true + +Bool b = !a + +print b.clss() // expect: @Bool diff --git a/test/types/type_range_operations.morpho b/test/types/type_range_operations.morpho new file mode 100644 index 000000000..fa1b4b648 --- /dev/null +++ b/test/types/type_range_operations.morpho @@ -0,0 +1,10 @@ +// Type checking with range operations + +Range r = 1...10 +Int sum = 0 + +for (i in r) { + sum = sum + i +} + +print sum // expect: 45 diff --git a/test/types/type_recursive.morpho b/test/types/type_recursive.morpho new file mode 100644 index 000000000..0df9c2f3c --- /dev/null +++ b/test/types/type_recursive.morpho @@ -0,0 +1,14 @@ +// Type checking with recursive functions + +fn factorial(Int n) { + if (n <= 1) { + return 1 + } + Int result = n * factorial(n - 1) + return result +} + +Int fact5 = factorial(5) +print fact5 // expect: 120 + + diff --git a/test/types/type_return.morpho b/test/types/type_return.morpho new file mode 100644 index 000000000..58d850b9d --- /dev/null +++ b/test/types/type_return.morpho @@ -0,0 +1,9 @@ +// Return type of a function matches type qualifier + +fn sqr(Int x) { + return x*x +} + +Int a = sqr(2) + +print a.clss() // expect: @Int diff --git a/test/types/type_return_builtin.morpho b/test/types/type_return_builtin.morpho new file mode 100644 index 000000000..115836b7f --- /dev/null +++ b/test/types/type_return_builtin.morpho @@ -0,0 +1,6 @@ +// Return type of a function matches type qualifier + +Float a = clock() + +print a.clss() // expect: @Float + diff --git a/test/types/type_return_builtin_is.morpho b/test/types/type_return_builtin_is.morpho new file mode 100644 index 000000000..8362ba0b0 --- /dev/null +++ b/test/types/type_return_builtin_is.morpho @@ -0,0 +1,5 @@ +// Return type of a function matches type qualifier + +Bool a = isstring("Hello") + +print a // expect: true diff --git a/test/types/type_return_metafunction.morpho b/test/types/type_return_metafunction.morpho new file mode 100644 index 000000000..1660d158b --- /dev/null +++ b/test/types/type_return_metafunction.morpho @@ -0,0 +1,17 @@ +// Return type of a function matches type qualifier + +fn sqr(Int x) { + return x*x +} + +fn sqr(Float x) { + return Int(x*x) +} + +Int a = sqr(2) + +Int b = sqr(2.5) + +print a.clss() // expect: @Int + +print b.clss() // expect: @Int diff --git a/test/types/type_runtime.morpho b/test/types/type_runtime.morpho new file mode 100644 index 000000000..d42719354 --- /dev/null +++ b/test/types/type_runtime.morpho @@ -0,0 +1,11 @@ +// Runtime typecheck + +{ + fn foo(x, y) { + return x + y + } + + var a = foo(1,2) + + Int b = a +} diff --git a/test/types/type_sparse_operations.morpho b/test/types/type_sparse_operations.morpho new file mode 100644 index 000000000..6a3e08244 --- /dev/null +++ b/test/types/type_sparse_operations.morpho @@ -0,0 +1,8 @@ +// Type checking with sparse matrix operations + +Sparse m = Sparse([[1, 1, 5], [2, 2, 10]]) +Int val = m[1, 1] + +print val // expect: 5 + + diff --git a/test/types/type_string_operations.morpho b/test/types/type_string_operations.morpho new file mode 100644 index 000000000..56c95e9a7 --- /dev/null +++ b/test/types/type_string_operations.morpho @@ -0,0 +1,10 @@ +// Type checking with string operations + +String s = "hello" +String t = "world" + +String combined = s + " " + t +Int len = combined.count() + +print combined // expect: hello world +print len // expect: 11 diff --git a/test/types/type_to_global_runtime.morpho b/test/types/type_to_global_runtime.morpho new file mode 100644 index 000000000..e17d11a6c --- /dev/null +++ b/test/types/type_to_global_runtime.morpho @@ -0,0 +1,9 @@ +// Store to upvalue + +fn f(x,y) { + return x + y +} + +Int a = f(1,2) + +print a // expect: 3 diff --git a/test/types/type_to_upvalue.morpho b/test/types/type_to_upvalue.morpho new file mode 100644 index 000000000..94ccb5598 --- /dev/null +++ b/test/types/type_to_upvalue.morpho @@ -0,0 +1,19 @@ +// Store to upvalue + +fn f(x) { + Int y = Int(x) + + fn g() { + y+=1 + return y + } + + return g +} + +var p = f(0) + +print p() // expect: 1 +print p() // expect: 2 +print p() // expect: 3 +print p() // expect: 4 diff --git a/test/types/type_try_catch.morpho b/test/types/type_try_catch.morpho new file mode 100644 index 000000000..ac93506ec --- /dev/null +++ b/test/types/type_try_catch.morpho @@ -0,0 +1,13 @@ +// Type checking in try/catch blocks + +fn risky(Int x) { + try { + Int result = x * 2 + return result + } catch { + "Err" : return 0 + } +} + +Int a = risky(5) +print a // expect: 10 diff --git a/test/types/type_tuple_operations.morpho b/test/types/type_tuple_operations.morpho new file mode 100644 index 000000000..507c215b2 --- /dev/null +++ b/test/types/type_tuple_operations.morpho @@ -0,0 +1,10 @@ +// Type checking with tuple operations + +Tuple t = (5, "hello") +Int first = t[0] +String second = t[1] + +print first // expect: 5 +print second // expect: hello + + diff --git a/test/types/type_while_loop.morpho b/test/types/type_while_loop.morpho new file mode 100644 index 000000000..5254cacd6 --- /dev/null +++ b/test/types/type_while_loop.morpho @@ -0,0 +1,13 @@ +// Type checking with while loops + +Int i = 0 +Int sum = 0 + +while (i < 5) { + sum = sum + i + i = i + 1 +} + +print sum // expect: 10 + + diff --git a/test/types/violations/type_violation_arithmetic.morpho b/test/types/violations/type_violation_arithmetic.morpho new file mode 100644 index 000000000..e3936c2a3 --- /dev/null +++ b/test/types/violations/type_violation_arithmetic.morpho @@ -0,0 +1,10 @@ +// Type violation in function from an arithmetic operation + +fn f() { + String u = "" + + u = 1+3 +} + +f() +// expect error 'TypeErr' diff --git a/test/types/violations/type_violation_arithmetic_runtime.morpho b/test/types/violations/type_violation_arithmetic_runtime.morpho new file mode 100644 index 000000000..95f41382d --- /dev/null +++ b/test/types/violations/type_violation_arithmetic_runtime.morpho @@ -0,0 +1,11 @@ +// Runtime typecheck + +fn f(x) { + return x +} + +{ + Int b = 1 + f(1.5) +} + +// expect error 'TypeChk' diff --git a/test/types/violations/type_violation_array_access.morpho b/test/types/violations/type_violation_array_access.morpho new file mode 100644 index 000000000..14a4e36f0 --- /dev/null +++ b/test/types/violations/type_violation_array_access.morpho @@ -0,0 +1,11 @@ +// Type violation with array access + +Array arr = Array(3) +arr[0] = 1 +arr[1] = 2 +arr[2] = 3 + +String val = arr[0] // expect error 'TypeChk' - arr[0] is Int, not String + + + diff --git a/test/types/violations/type_violation_assign_upvalue.morpho b/test/types/violations/type_violation_assign_upvalue.morpho new file mode 100644 index 000000000..27f31b7bf --- /dev/null +++ b/test/types/violations/type_violation_assign_upvalue.morpho @@ -0,0 +1,14 @@ +// Store to upvalue with type violation + +fn f(x) { + Int y = Int(x) + + fn g() { + y+=1.5 + return y + } + + return g +} + +// expect error 'TypeErr' diff --git a/test/types/violations/type_violation_call_runtime.morpho b/test/types/violations/type_violation_call_runtime.morpho new file mode 100644 index 000000000..fed0e1fe6 --- /dev/null +++ b/test/types/violations/type_violation_call_runtime.morpho @@ -0,0 +1,8 @@ +// Assign result of a function to a type protected variable + +fn idem(x) { return x } + +{ + Int a = idem(1.2) +} +// expect error 'TypeChk' diff --git a/test/types/violations/type_violation_comparison.morpho b/test/types/violations/type_violation_comparison.morpho new file mode 100644 index 000000000..61a591e0f --- /dev/null +++ b/test/types/violations/type_violation_comparison.morpho @@ -0,0 +1,10 @@ +// Type violation in function from a type comparison + +fn f() { + String u = "" + + u = 1<3 +} + +f() +// expect error 'TypeErr' diff --git a/test/types/violations/type_violation_complex_inheritance.morpho b/test/types/violations/type_violation_complex_inheritance.morpho new file mode 100644 index 000000000..671b943f3 --- /dev/null +++ b/test/types/violations/type_violation_complex_inheritance.morpho @@ -0,0 +1,11 @@ +// Type violation with complex inheritance + +class A { } +class B is A { } +class C is A { } + +fn f() { + B b = C() // expect error 'TypeErr' - C is not a subclass of B +} + +f() diff --git a/test/types/type_violation_constant.morpho b/test/types/violations/type_violation_constant.morpho similarity index 100% rename from test/types/type_violation_constant.morpho rename to test/types/violations/type_violation_constant.morpho diff --git a/test/types/violations/type_violation_continuation.morpho b/test/types/violations/type_violation_continuation.morpho new file mode 100644 index 000000000..1151ecda6 --- /dev/null +++ b/test/types/violations/type_violation_continuation.morpho @@ -0,0 +1,12 @@ +// Check types from continuation + +fn f(x) { + return x +} + +{ + Int b = f(1) + Float a = b +} + +// expect error 'TypeChk' diff --git a/test/types/violations/type_violation_continuation_subtypes.morpho b/test/types/violations/type_violation_continuation_subtypes.morpho new file mode 100644 index 000000000..d3e6ad7b8 --- /dev/null +++ b/test/types/violations/type_violation_continuation_subtypes.morpho @@ -0,0 +1,15 @@ +// Check types from continuation + +class A { } + +class B is A { } + +class C is A { } + +{ + A a = B() + B b = a + C c = a +} + +// expect error 'TypeErr' diff --git a/test/types/violations/type_violation_continuation_subtypes_runtime.morpho b/test/types/violations/type_violation_continuation_subtypes_runtime.morpho new file mode 100644 index 000000000..26b577cf8 --- /dev/null +++ b/test/types/violations/type_violation_continuation_subtypes_runtime.morpho @@ -0,0 +1,17 @@ +// Check types from continuation + +class A { } + +class B is A { } + +class C is A { } + +fn f(x) { return x } + +{ + A a = f(B()) + B b = a + C c = a +} + +// expect error 'TypeChk' diff --git a/test/types/type_violation_dictionary.morpho b/test/types/violations/type_violation_dictionary.morpho similarity index 86% rename from test/types/type_violation_dictionary.morpho rename to test/types/violations/type_violation_dictionary.morpho index dc29b6670..f129f0b47 100644 --- a/test/types/type_violation_dictionary.morpho +++ b/test/types/violations/type_violation_dictionary.morpho @@ -1,7 +1,7 @@ // Type violation in function from a Dictionary fn f() { - String u + String u = "" u = { "a" : "b" } } diff --git a/test/types/violations/type_violation_dictionary_access.morpho b/test/types/violations/type_violation_dictionary_access.morpho new file mode 100644 index 000000000..2fd07d157 --- /dev/null +++ b/test/types/violations/type_violation_dictionary_access.morpho @@ -0,0 +1,5 @@ +// Type violation with dictionary access + +Dictionary dict = { "a": 1, "b": 2 } + +String val = dict["a"] // expect error 'TypeChk' - dict["a"] is Int, not String diff --git a/test/types/violations/type_violation_fn.morpho b/test/types/violations/type_violation_fn.morpho new file mode 100644 index 000000000..b078c0755 --- /dev/null +++ b/test/types/violations/type_violation_fn.morpho @@ -0,0 +1,7 @@ +// Assign a function to a type protected variable + +fn sqr(x) { return x^2 } + +Int a = sqr + +// expect error 'TypeErr' diff --git a/test/types/violations/type_violation_global.morpho b/test/types/violations/type_violation_global.morpho new file mode 100644 index 000000000..4eba5b742 --- /dev/null +++ b/test/types/violations/type_violation_global.morpho @@ -0,0 +1,6 @@ +// Type violation due to a constructor + +String u = "" +u = 1 + +// expect error 'TypeErr' diff --git a/test/types/type_violation_global.morpho b/test/types/violations/type_violation_global_initializer.morpho similarity index 100% rename from test/types/type_violation_global.morpho rename to test/types/violations/type_violation_global_initializer.morpho diff --git a/test/types/violations/type_violation_global_runtime.morpho b/test/types/violations/type_violation_global_runtime.morpho new file mode 100644 index 000000000..72d6142d5 --- /dev/null +++ b/test/types/violations/type_violation_global_runtime.morpho @@ -0,0 +1,12 @@ +// Runtime typecheck + +fn foo(x, y) { + return x + y +} + +var a = foo(1.5,2) +{ + Int b = a +} + +// expect error 'TypeChk' \ No newline at end of file diff --git a/test/types/type_violation_in_function.morpho b/test/types/violations/type_violation_in_function.morpho similarity index 82% rename from test/types/type_violation_in_function.morpho rename to test/types/violations/type_violation_in_function.morpho index f1ed09745..6682fff9d 100644 --- a/test/types/type_violation_in_function.morpho +++ b/test/types/violations/type_violation_in_function.morpho @@ -1,7 +1,7 @@ // Type violation in function fn f() { - String u + String u = "" u = [] } diff --git a/test/types/type_violation_inheritance.morpho b/test/types/violations/type_violation_inheritance.morpho similarity index 100% rename from test/types/type_violation_inheritance.morpho rename to test/types/violations/type_violation_inheritance.morpho diff --git a/test/types/type_violation_instance.morpho b/test/types/violations/type_violation_instance.morpho similarity index 100% rename from test/types/type_violation_instance.morpho rename to test/types/violations/type_violation_instance.morpho diff --git a/test/types/violations/type_violation_interpolation.morpho b/test/types/violations/type_violation_interpolation.morpho new file mode 100644 index 000000000..bce5d8395 --- /dev/null +++ b/test/types/violations/type_violation_interpolation.morpho @@ -0,0 +1,7 @@ +// Type propagation from interpolation + +{ + var a = 1 + Int b = "a=${a}" + // expect error 'TypeErr' +} diff --git a/test/types/violations/type_violation_invoke_runtime.morpho b/test/types/violations/type_violation_invoke_runtime.morpho new file mode 100644 index 000000000..110216ae1 --- /dev/null +++ b/test/types/violations/type_violation_invoke_runtime.morpho @@ -0,0 +1,11 @@ +// Assign result of a function to a type protected variable + +class A { + foo(x) { return x } +} + +{ + var a = A() + Int b = a.foo(1.2) +} +// expect error 'TypeChk' diff --git a/test/types/type_violation_matrix.morpho b/test/types/violations/type_violation_matrix.morpho similarity index 85% rename from test/types/type_violation_matrix.morpho rename to test/types/violations/type_violation_matrix.morpho index bdf0d7f93..ac0e55a8c 100644 --- a/test/types/type_violation_matrix.morpho +++ b/test/types/violations/type_violation_matrix.morpho @@ -1,7 +1,7 @@ // Type violation in function from a Matrix fn f() { - String u + String u = "" u = Matrix(2,2) } diff --git a/test/types/violations/type_violation_method_chaining.morpho b/test/types/violations/type_violation_method_chaining.morpho new file mode 100644 index 000000000..78b0665d0 --- /dev/null +++ b/test/types/violations/type_violation_method_chaining.morpho @@ -0,0 +1,9 @@ +// Type violation in method chaining + +class Counter { + init() { self.value = 0 } + add(Int x) { self.value = self.value + x; return self } + get() { return self.value } +} + +String result = Counter().add(5).get() // expect error 'TypeChk' - get() returns Int, not String diff --git a/test/types/violations/type_violation_multi.morpho b/test/types/violations/type_violation_multi.morpho new file mode 100644 index 000000000..0d6f7f01c --- /dev/null +++ b/test/types/violations/type_violation_multi.morpho @@ -0,0 +1,12 @@ +// Function with multiple return types + +fn f(Int x) { + if (x<0) { + return x + 1 + } + return x - 1 +} + +Float a = f(2) + +// expect error 'TypeErr' diff --git a/test/types/violations/type_violation_multiple_dispatch.morpho b/test/types/violations/type_violation_multiple_dispatch.morpho new file mode 100644 index 000000000..648e24b35 --- /dev/null +++ b/test/types/violations/type_violation_multiple_dispatch.morpho @@ -0,0 +1,15 @@ +// Type violation with multiple dispatch + +class Animal { } +class Dog is Animal { } +class Cat is Animal { } + +fn speak(Animal a) { + return "animal sound" +} + +fn speak(Dog d) { + return "woof" +} + +Int result = speak(Cat()) // expect error 'TypeErr' - speak returns String, not Int diff --git a/test/types/violations/type_violation_narrowing.morpho b/test/types/violations/type_violation_narrowing.morpho new file mode 100644 index 000000000..2753ad085 --- /dev/null +++ b/test/types/violations/type_violation_narrowing.morpho @@ -0,0 +1,12 @@ +// Type violation with incorrect type narrowing + +fn process(x) { + if (isint(x)) { + String s = x + return s + } + return nil +} + +print process(5) +// expect error 'TypeChk' - x is Int, not String diff --git a/test/types/violations/type_violation_nil.morpho b/test/types/violations/type_violation_nil.morpho new file mode 100644 index 000000000..37d946928 --- /dev/null +++ b/test/types/violations/type_violation_nil.morpho @@ -0,0 +1,7 @@ +// Assign nil to a type protected variable + +Int a = 1 + +a = nil + +// expect error 'TypeErr' diff --git a/test/types/violations/type_violation_nil_return.morpho b/test/types/violations/type_violation_nil_return.morpho new file mode 100644 index 000000000..7535d9fa5 --- /dev/null +++ b/test/types/violations/type_violation_nil_return.morpho @@ -0,0 +1,7 @@ +// Assign nil result to a type protected variable + +fn foo(x) { } + +Int a = foo(1) + +// expect error 'TypeErr' diff --git a/test/types/violations/type_violation_power.morpho b/test/types/violations/type_violation_power.morpho new file mode 100644 index 000000000..b2a5d2d35 --- /dev/null +++ b/test/types/violations/type_violation_power.morpho @@ -0,0 +1,10 @@ +// Type violation in function from a power operation + +fn f() { + String u = "" + + u = 2^2 +} + +f() +// expect error 'TypeErr' diff --git a/test/types/type_violation_propagation.morpho b/test/types/violations/type_violation_propagation.morpho similarity index 86% rename from test/types/type_violation_propagation.morpho rename to test/types/violations/type_violation_propagation.morpho index 7b48732ca..b3593d7eb 100644 --- a/test/types/type_violation_propagation.morpho +++ b/test/types/violations/type_violation_propagation.morpho @@ -1,7 +1,7 @@ // Detect type violations from propagation fn f() { - String u + String u = "" var a = 1 diff --git a/test/types/violations/type_violation_property.morpho b/test/types/violations/type_violation_property.morpho new file mode 100644 index 000000000..df23e6c6c --- /dev/null +++ b/test/types/violations/type_violation_property.morpho @@ -0,0 +1,8 @@ + +var a = Object() +a.a = 1.5 + +{ + Int b = a.a +} +// expect error 'TypeChk' diff --git a/test/types/type_violation_range.morpho b/test/types/violations/type_violation_range.morpho similarity index 84% rename from test/types/type_violation_range.morpho rename to test/types/violations/type_violation_range.morpho index 16cfb4fa7..d22e0419c 100644 --- a/test/types/type_violation_range.morpho +++ b/test/types/violations/type_violation_range.morpho @@ -1,7 +1,7 @@ // Type violation in function from a Range fn f() { - String u + String u = "" u = 1..3 } diff --git a/test/types/violations/type_violation_return.morpho b/test/types/violations/type_violation_return.morpho new file mode 100644 index 000000000..ca538e462 --- /dev/null +++ b/test/types/violations/type_violation_return.morpho @@ -0,0 +1,9 @@ +// Return type of a function matches type qualifier + +fn f(Int x) { + return 2.5*x +} + +Int a = f(2) + +// expect error 'TypeErr' diff --git a/test/types/violations/type_violation_runtime.morpho b/test/types/violations/type_violation_runtime.morpho new file mode 100644 index 000000000..891cb8b0a --- /dev/null +++ b/test/types/violations/type_violation_runtime.morpho @@ -0,0 +1,13 @@ +// Runtime typecheck + +{ + fn foo(x, y) { + return x + y + } + + var a = foo(1.5,2) + + Int b = a +} + +// expect error 'TypeChk' diff --git a/test/types/violations/type_violation_to_global_runtime.morpho b/test/types/violations/type_violation_to_global_runtime.morpho new file mode 100644 index 000000000..16315a982 --- /dev/null +++ b/test/types/violations/type_violation_to_global_runtime.morpho @@ -0,0 +1,11 @@ +// Runtime typecheck + +fn foo(x, y) { + return x + y +} + +var a = foo(1.5,2) + +Int b = a + +// expect error 'TypeChk' \ No newline at end of file diff --git a/test/types/violations/type_violation_tuple.morpho b/test/types/violations/type_violation_tuple.morpho new file mode 100644 index 000000000..6b216114e --- /dev/null +++ b/test/types/violations/type_violation_tuple.morpho @@ -0,0 +1,10 @@ +// Type violation due to a constructor + +fn f() { + String u = "" + + u = Tuple(1,2,3) +} + +f() +// expect error 'TypeErr' diff --git a/test/types/violations/type_violation_upvalue_runtime.morpho b/test/types/violations/type_violation_upvalue_runtime.morpho new file mode 100644 index 000000000..da7109ae9 --- /dev/null +++ b/test/types/violations/type_violation_upvalue_runtime.morpho @@ -0,0 +1,14 @@ +// Retrieve type from upvalue with typecheck + +fn f(x) { + var y = x + + fn g() { + Int z = y + return z + } + + return g +} + +print f(1.5)() // expect error 'TypeChk'